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FOREWORD 

This  report  is  a  documentation  of  the  highway  data  bank  research 
undertaken  by  the  Department  of  Civil  Engineering  and  Engineering  Mechanics, 
Montana  State  University.   The  research  was  sponsored  by  the  Montana  Depart- 
ment of  Highways  in  cooperation  with  the  U.S.  Department  of  Transportation, 
Federal  Highway  Administration. 

Conceptually,  the  CE  &  EM  Department  was  responsible  for  developing  an 
information  retrieval  system  for  rapid  access  to  highway  data.   Specifically, 
the  responsibility  was  to  produce  the  Roadlog,  Traffic  by  Sections,  Accident 
by  Sections  and  Sufficiency  by  Sections  reports  as  a  direct  application  of 
the  system.   In  addition,  preliminary  investigation  of  the  feasiblity  of  a 
geometries  file  and  a  preliminary  investigation  of  the  storage  and  retrieval 
of  visual  images  was  included  in  the  project  objectives. 

In  light  of  the  foregoing,  it  is  desirable  to  present  the  report  in  two 
volumes :   Highway  Information  System  Volume  1:   User  Information,  and  Highway 
Information  System  Volume  2;   Programmer  Information.   Volume  1  deals  with  the 
use  of  the  system,  including  information  on  data  coding  and  on  the  execution 
of  programs  within  the  system.   Volume  2  deals  with  the  detailed  operation  of 
the  system,  providing  information  on  the  modification  of  programs  existing 
within  the  system  as  well  as  on  the  addition  of  programs  to  the  system. 
Volume  1  is  a  prerequisite  publication  to  Volume  2. 

In  developing  the  system,  the  CE  &  EM  Department  has  had  the  privilege 
of  using  an  IBM  OS  360/40  computer  located  at  the  Data  Processing  Bureau  of 
the  Montana  Department  of  Highways  in  Helena.   PL/I  has  been  used  as  the 
programming  language  for  nearly  all  of  the  HIS  routines  because  of  its  versa- 
tility in  input-output  (I/O)  and  interchangeability  of  files.   BAL  (assembler) 
has  been  used  for  several  routines  because  of  its  increased  capabilities  and 
efficiency  over  other  languages. 

The  project  could  never  have  progressed  to  its  current  state  were  it  not 
for  the  continual  encouragement  from  and  the  patient,  sustained  assistance  of 
both  the  Planning  and  Research  Bureau  and  the  Data  Processing  Bureau  of  the 
Montana  Department  of  Highways,  and  of  the  Montana  State  Highway  Patrol. 

The  project  conclusion  was  also  hastened  by  the  significant  effort  of 
other  project  personnel:   Francis  C.  F.  Yu,  Leroy  R.  Zook,  Philip  A.  House, 


Alfred  C.  Scheer,  Paul  W.  Burkhart,  Robert  C.  Smith,  Harry  E.  Hughes, 
Ronald  E.  Billstein,  Daniel  D.  Urbach  and  Donald  R.  Reichmuth.  Their 
assistance  has  been  invaluable. 
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CHAPTER  2-1 
INTRODUCTION 

HIS  consists  of  a  large  number  of  file-maintenance  and  summary-producing 
programs  integrated  into  a  user-oriented  system.   To  aid  the  user  in  the  use 
of  the  programs,  a  supervisor  has  been  included  in  the  system. 

The  supervisor  is  necessary  for  two  reasons.   First,  the  large  number  of 
programs,  each  executed  separately,  would  cause  a  large  amount  of  OS  JCL  to 
be  required.   Second,  the  supervisor  aids  in  the  communication  between  separate 
routines. 

The  user  must  communicate  his  needs  to  the  supervisor  by  means  of  HIS 
command  cards.   These  commands  are  written  in  a  largely  free-format  user- 
oriented  language,  and  are  difficult  to  handle  internally.   To  bridge  this 
problem,  a  "command  decoder"  routine  is  provided  which  transforms  the  commands 
into  a  fixed-format  record,  called  an  "instruction."  The  supervisor  reads 
each  of  the  instructions,  and  executes  them  by  loading  the  proper  routine 
into  core  for  execution. 

HIS  is  designed  to  run  in  conjunction  with  the  IBM  System/360  Operating 
System  (OS) .  Figure  2-1-1  shows  the  relationship  between  the  HIS  components 
and  OS. 

As  can  be  seen  from  Figure  2-1-1,  user  input  falls  into  three  categories: 
1)  OS  Job  Control  Language  (JCL),  2)  commands  to  the  HIS  supervisor,  and 
3)  input  data  to  HIS  routines. 

OS  JCL  is  required  in  order  to  instruct  the  Operating  System  to  execute 
the  HIS  supervisor.   HIS  commands  are  required  to  define  the  operations  to 
be  performed,  and  to  execute  the  proper  HIS  routines.   Input  data  is  required 
by  some  of  the  HIS  routines  in  order  to  update  HIS  data  files. 

The  following  signs  and  conventions,  consistent  with  those  used  by  IBM, 
have  been  adopted  throughout  these  manuals : 

1)  Uppercase  letters  and  punctuation  marks  (except  for  brackets  and 
braces)  must  be  coded. 

2)  Lowercase  letters  and  terms  represent  information  that  must  be 
supplied  by  the  user. 

3)  Information  contained  within  brackets     represents  an  option  that 
may  be  included  or  omitted,  depending  upon  the  requirements  of  the  user. 
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INPUT 
DATA 


FLOW       OF 
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FLOW       OF 
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Figure  2-1-1.      HIS  organization, 
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4)  Options  contained  within  braces <   > represent  alternatives,  one 
(and  only  one)  of  which  must  be  chosen. 


HIS  Commands 

HIS  command  cards  are  identified  by  a  colon  (:)  in  column  1.   All  commands 
must  contain  this  identification.   Immediately  following  the  colon  is  coded 
the  name  of  the  HIS  program  to  be  executed. 

Most  routines  allow  one  or  more  options  to  be  selected  by  the  user. 
These  options  are  selected  by  means  of  parameters  coded  on  the  command  follow- 
ing the  program  name.   Each  parameter  consists  of  a  keyword  and  an  option, 
separated  by  an  equal  sign  (e.g.,  FILE=ROADLOG) .   The  first  parameter  is 
separated  by  a  comma  from  the  program  name.   Additional  parameters  are 
separated  by  commas.   The  last  parameter  must  be  followed  by  at  least  one 
blank. 

Continuation  cards  —  When  a  command  is  too  large  to  be  contained  on  a 
single  card,  it  may  be  continued  on  another  card  by  placing  a  comma  after  a 
complete  parameter,  leaving  the  remainder  of  the  card  blank.   The  continuation 
card  must  contain  a  colon  in  column  1,  followed  by  one  or  more  blanks. 
Examples  of  HIS  commands  are: 

LIST-&-SUM ,REPORT=ROADLOG ,DATA=PRIM , PAGE-NUMBER=60 

SURF-TYPE ,REPORT=ROADLOG ,DATA=SEC , SUMMARY=RTE-NO , 
MILEAGE=ALL ,TABLE-NUMBER=6 

UPDATE, FILE=TRAFFIC ,FUNCTION=INSERT ,DDNAME=INDD 
Instructions 

Because  the  command  format  is  largely  free-form,  it  is  rather  unweildy 
to  process.   The  commands  are  thus  translated  into  a  fixed-form  record  for 
internal  handling.   This  internal  format  is  referred  to  as  an  instruction. 

The  first  four  characters  of  the  instruction  give  the  name  of  a  load 
module  located  in  the  step  library  which  is  to  be  executed.  A  portion  of 
the  name  is  computed  directly  from  the  program  name  specified  on  the  command. 
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The  remainder  of  the  name  may  be  filled  in  from  parameters  coded  on  the 
command . 

The  remaining  characters  of  the  instruction  contain,  in  simplified  form, 
the  additional  information  included  on  the  command.   Each  parameter  is  asigned 
a  specific  column,  or  columns,  in  the  instruction  as  shown  in  Table  2-I-I. 

For  example,  a  number  of  programs  are  available  under  HIS  for  updating 
data  files.   These  programs  are  invoked  by  specifying  the  program  name  UPDATE 
on  the  command.   Three  parameters  are  required  on  UPDATE  commands:   FILE, 
FUNCTION,  and  DDNAME.   The  file  parameter  indicates  the  name  of  the  file  to 
be  updated  (e.g.,  ROADLOG  or  TRAFFIC).   The  function  parameter  indicates 
whether  records  are  to  be  inserted,  deleted,  or  rewritten.   The  DDNAME 
parameter  gives  the  name  of  a  DD  statement  used  to  enter  the  update  data. 
Three  separate  programs  are  available  for  each  file;  one  performing  each  of 
the  tasks:   insertion,  deletion,  or  revision.   Hence,  the  FUNCTION  parameter 
is  used,  along  with  the  FILE  parameter,  to  define  the  load  module  name.   The 
internal  name  of  the  UPDATE  program  is  PD.   If  FILE=ROADLOG  and  FUNCTION= 
INSERT  are  coded,  an  R  appears  in  column  3,  and  an  I  appears  in  column  4. 
Hence,  the  load  module  name  for  this  routine  is  PDRI.   Similarly,  when 
FILE=TRAFFIC,FUNCTION=DELETE  is  specified,  the  load  module  name  is  PDTD. 
The  DDNAME  parameter  is  not  used  to  complete  the  load  module  name,  but  is 
examined  by  the  update  routine  invoked  when  the  instruction  is  executed  to 
determine  the  location  of  its  data. 

Formatting  of  Output 

A  number  of  the  HIS  routines  produce  summaries  which  will  be  reproduced 
for  printing  directly  from  the  computer  printout.   For  this  reason,  a  number 
of  options  are  available  to  the  user  in  the  formatting  of  output.   These 
formatting  options  affect  all  three  of  the  HIS  components  (supervisor,  command 
decoder,  and  file-maintenance  and  summary -producing  programs). 

Page  size  option  —  The  user  must  be  able  to  vary  the  number  of  lines 
printed  on  each  page.   He  does  this  by  specifying  PAGE-SIZE=nn  in  the  command, 
where  nn  is  the  number  of  lines  per  page.   The  command  decoder  must  recognize 
the  PAGE-SIZE  keyword,  and  place  the  number  nn  in  columns  7  and  8  of  the 
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TABLE  2-I-I 
INSTRUCTION  FORMAT 


Parameter  Name 


Instruction  Column (s) 


Remarks 


FILE 

3 

See 

Note 

1 

below. 

REPORT 

3 

See 

Note 

2 

below. 

SUMMARY 

4 

See 

Note 

3 

below. 

FHSUMMARY 

4 

See 

Note 

4 

below. 

FUNCTION 

4 

See 

Note 

5 

below. 

PHASE 

4 

See 

Note 

6 

below. 

MILEAGE 

5 

See 

Note 

7 

below. 

LIST 

5 

See 

Note 

8 

below. 

PAGE-SIZE 

7-8 

See 

Note 

9 

below. 

TOP-MARGIN 

11-12 

See 

Note 

9 

below. 

PAGE-NUMBER 

15-19 

See 

Note 

9 

below. 

TABLE-NUMBER 

21-22 

See 

Note 

9 

below. 

PAGE-EJECT 

23 

See 

Note 

10 

|  below 

DDNAME 

24-31 

See 

Note 

11 

below 

LNDD 

24-31 

See 

Note 

11 

below 

START-DATE 

24-31 

See 

Note 

11 

below 

OUTDD 

32-39 

See 

Note 

11 

below 

END-DATE 

32-39 

See 

Note 

11 

.  below 

LOCATION 

40-57 

See 

Note 

11 

below 

STARTKEY 

40-55 

See 

Note 

11 

below 

ENDKEY 

56-71 

See 

Note 

11 

below 

ODD-PAGE-POSITION 

73-75 

See 

Note 

9 

below. 

EVEN-PAGE-POS IT ION 

76-78 

See 

Note 

9 

below. 

FORMAT 

7-8  and  73-78 

See 

Note 

12 

below 

DATA 

6  and  40-71 

See 

Note 

13 

below 

Miscellaneous  Uses 

remaining  columns 

See 

Note 

14 

below 

Notes:   1.   The  FILE  parameter  is  used  to  complete  the  load  module  name. 

The  allowable  options  and  their  corresponding  internal  codes 
are: 


"R" 


ROADLOG 
TRAFFIC 

TRUMILE     "M 
SUFFICIENCY  "S" 
ACCIDENT    "A" 


limit 
ll-Kxt  I 


The  REPORT  parameter  is  used  to  complete  the  load  module  name. 
The  allowable  options  and  their  corresponding  internal  codes 
are: 

ROADLOG  "R" 
TRAFFIC  "T" 
SUFFICIENCY  MS" 
ACCIDENT  "A" 
SMTABLES     "Q" 
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TABLE  2-I-I  (continued) 


3.   The  SUMMARY  parameter  is  used  to  complete  the  SURF -TYPE  load 
module  name.   The  allowable  options  and  their  corresponding 
internal  codes  are: 


RTE-NO 

n-i  it 

PROJ-# 

Mo  If 

COUNTY 

„3„ 

CITIES 

"4" 

YR-BLT 

Mrll 

SUR-WD 

"6" 

YR-IMP 

M-7II 

4.  The  FHSUMMARY  parameter  is  used  to  complete  the  FORHWY-SUMMARY 

load  module  name.   The  allowable  options  and  their  corresponding 
internal  codes  are: 

LOCATION    "L" 
SURF-TYPE    "S" 

5.  The  FUNCTION  parameter  is  used  to  complete  the  load  module  name 

of  UPDATE.   The  allowable  options  and  their  corresponding 
internal  codes  are: 


DELETE 

"D" 

INSERT 

"I" 

REWRITE 

"R" 

NEW-KEY 

"N" 

6.  The  PHASE  parameter  is  used  to  complete  the  load  module  names 
of  CREATE-SUFFSUB  and  CREATE-ACCSUB.  The  allowable  options 
and  their  corresponding  internal  codes  are: 


ACCIDENT 

"A" 

ROADLOG 

"R" 

TRAFFIC 

llrpll 

SECTIONS 

l.gl, 

SUFFICIENCY 

"S" 

COMPUTATIONS 

"C" 

7.  The  MILEAGE  parameter  is  used  by  SURF-TYPE  to  determine  whether 

urban  mileage  or  all  mileage  is  to  be  processed.   The  allowable 
options  and  their  corresponding  internal  codes  are: 

URBAN       "U" 
ALL         "A" 

8.  The  LIST  parameter  is  used  by  COPY  and  CREATE  to  determine 

whether  a  "dump"  listing  is  required.   The  allowable  options 
and  their  internal  codes  are: 
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TABLE  2-I-I  (continued) 


YES         "Y" 
NO  "N" 

9.   The  PAGE-SIZE,  TOP-MARGIN,  PAGE-NUMBER,  TABLE-NUMBER, 

ODD-PAGE-POSITION,  and  EVEN-PAGE-POSITION  are  numeric  values 
coded  for  HIS  formatting  options.   The  numbers  coded  on  the 
command  are  placed,  in  character  format,  into  the  proper 
columns  of  the  instruction. 

10.  PAGE-EJECT=SUPPRESS  is  the  only  valid  form  of  the  PAGE-EJECT 

parameter.   When  this  parameter  is  coded,  an  "S"  is  placed 
in  instruction  column  23. 

11.  These  parameters  provide  the  capability  of  linking  a  character 

string  from  the  command  to  the  HIS  routines.   The  option 
coded  in  the  parameter  is  copied  directly  into  the  appro- 
priate columns  of  the  instruction. 

12.  The  FORMAT  parameter  is  essentially  a  "macro"  parameter. 

FORMAT=REDUCE  is  identical  to  the  sequence  PAGE-SIZE=60, 
EVEN-PAGE-P0SITI0N=1,  ODD-PAGE-POSITION=120 .   FORMAT=NOREDUCE 
is  Identical  to  the  sequence  PAGE-SIZE=46,  EVEN-PAGE-P0SITI0N=1, 
ODD-PAGE-POSITION=98 . 

13.  The  DATA  parameter  provides  a  versatile  method  of  entering 

beginning  and  ending  keys  into  the  instruction.   The  decoder 
calculates  the  actual  keys.   Column  6  is  given  a  value  for 
the  following  options: 


INT 

it  -p  ii 

PRIM 

npii 

SEC 

ng.i 

INT+PRIM 

"C" 

ILOOP 

"L" 

ALL 

"A" 

All  other  options  result  in  a  blank  in  column  6.   Columns  40-55 
are  filled  with  a  starting  key.   Columns  56-71  are  filled  in 
with  an  ending  key. 
14.   Columns  9-10  are  used  during  the  execution  of  a  HIS  routine  to 
count  the  number  of  lines  printed  on  a  page.   Column  72  is 
used  during  the  execution  of  a  HIS  routine  to  indicate  the 
number  of  page  headings  to  be  printed  on  each  page.   Columns 
1-2  are  the  first  portion  of  the  load  module  name,  and  are 
filled  in  from  the  program  name  coded  on  the  command.   The 
remaining  columns  (13-14,  20,  and  79-100)  are  presently  unused. 
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instruction.   If  the  PAGE-SIZE  keyword  is  not  coded  on  a  command,  columns  7 
and  8  of  the  instruction  will  be  left  blank.   The  supervisor  must  check  each 
instruction  processed  to  see  whether  columns  7  and  8  contain  a  value.   If  no 
value  is  present,  a  default  value  is  padded  in.   The  default  value  at  the 
beginning  of  system  execution  is  60  lines  per  page,  but  this  value  may  be 
altered  by  the  user  for  the  duration  of  a  run.   Each  of  the  HIS  programs  must 
check  this  field  when  printing,  and  print  the  correct  number  of  lines  on  each 
page. 

Page  position  —  The  page  position  field  of  the  instruction  (columns  9 
and  10)  cannot  be  filled  in  by  the  user.   The  decoder  will  always  leave  these 
columns  blank.   The  page  position  field  is  used  to  keep  track  of  the  present 
position  of  the  line  printer  in  order  to  detect  when  a  new  page  is  to  be 
printed.   The  supervisor  normally  fills  this  field  in  with  the  same  value  as 
the  page  size,  indicating  to  the  called  program  that  a  new  page  is  to  be 
started.   (When  PAGE-EJECT=SUPPRESS  is  coded,  this  convention  is  not  followed. 
See  PAGE-EJECT  option,  below) .   The  called  program  must  always  return  the 
present  page  position  in  this  field  when  control  is  returned  to  the  supervisor. 

Page  numbering  option  —  The  user  must  be  able  to  number  pages  as  they 
are  printed.   Several  summaries  may  be  printed  serially  by  separate  programs, 
and  the  pages  numbered  consecutively.   Hence,  each  program  has  to  return  the 
present  page  number  value  to  the  supervisor  when  returning  control.   The 
decoder  must  recognize  three  forms  of  the  page  number  option.   The  first 
form  is  PAGE-NUMBER=nnnn  (four  digits  maximum) .   The  number  coded  (preceded 
by  blanks  if  shorter  than  four  digits)  is  placed  in  columns  15  through  18 
of  the  instruction,  and  column  19  is  left  blank.   The  second  form  is  PAGE- 
NUMBER=$+nnnn,  indicating  that  the  value  nnnn  is  to  be  added  to  the  current 
page  number  to  allow  the  insertion  of  maps  or  figures  into  a  report.   Again, 
the  number  nnnn  is  placed  in  columns  15  through  18  of  the  instruction.   A 
dollar  sign  character  ($)  is  placed  in  column  19.   The  final  form,  PAGE- 
NUMBER=STOP,  is  used  to  end  page  numbering.   The  decoder  places  a  character 
"X"  in  column  15,  leaving  columns  16  through  19  blank.   If  no  PAGE-NUMBER 
parameter  is  present  on  the  command,  the  instruction  will  contain  blanks  in 
columns  15  through  19.   The  supervisor  must  keep  track  of  page  numbering.   A 
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field  of  blanks  is  initially  established,  indicating  that  page  numbering  has 
not  yet  been  initiated.   After  page  numbering  has  started,  this  field  contains 
the  page  numbers  returned  from  called  programs.   If  the  page  number  field  of 
an  instruction  contains  blanks,  this  field  is  copied  into  the  instruction. 
Hence,  if  the  field  is  blanks,  page  numbering  will  not  be  initiated.   If  the 
field  is  not  blanks ,  the  next  page  number  to  be  used  is  placed  into  the 
instruction.   If  PAGE-NUMBER=n  was  specified,  the  supervisor  need  do  nothing 
because  page  number  position  of  the  instruction  is  already  complete.   If 
PAGE-NUMBER=$+n  was  specified,  the  supervisor  must  add  the  number  coded  to 
the  value  in  the  saved  page  number  field.   The  result  is  filled  into  columns 
15  through  18  of  the  instruction.   If  PAGE-NUMBER=STOP  is  specified,  the 
supervisor  must  replace  the  "X"  in  column  15  with  a  blank,  to  indicate  the 
absence  of  page  numbering.   The  called  program  has  the  responsibility  of 
printing  the  page  numbers.   If  the  page  number  field  contains  blanks,  the 
called  program  does  not  print  page  numbers.   If  the  page  number  field  contains 
a  value,  the  first  new  page  started  by  the  program  contains  this  page  number. 
The  called  program  should  then  increment  this  value  to  indicate  the  next 
page  number.   Hence,  when  control  is  returned,  this  field  contains  the  value 
of  the  next  page  number  to  be  printed.   It  will  be  noted  that  the  forms 
PAGE-NUMBER=$+nnnn  and  PAGE-NUMBER=STOP  are  processed  entirely  by  the 
supervisor,  and  do  not  need  to  be  checked  for  by  the  called  program. 

Page  number  positioning  options  —  Depending  upon  the  method  of  printing 
and  binding,  the  location  at  which  page  numbers  will  be  printed  on  the  page 
must  be  adjustable.   Some  of  the  reports  printed  require  that  odd  page 
numbers  be  printed  in  a  different  location  from  even  page  numbers.   The  user 
indicates  the  position  of  page  numbers  by  coding  ODD-PAGE-POSITION=nnn  and 
EVEN-PAGE-POSITION=nnn.   The  decoder  must  recognize  the  keywords  when  present, 
and  fill  the  odd  value  into  columns  73-75,  and  the  even  value  into  columns 
76-78.   If  not  coded  on  the  command,  the  instruction  fields  will  be  blank. 
The  supervisor  must  check  these  columns,  and,  if  blank,  fill  in  a  default 
value.   The  default  values  for  both  fields  are  initially  120,  but  are  adjustable 
by  the  user.   The  called  program  must  consult  these  fields  whenever  a  page 
number  is  to  be  printed  in  order  to  place  the  page  number  in  the  proper  loca- 
tion.  The  decoder  must  also  recognize  the  keyword  FORMAT,  with  options 
NOREDUCE  and  REDUCE.   FORMAT=REDUCE  is  equivalent  to  coding  the  three  param- 
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eters  PAGE-SIZE=60,ODD-PAGE-POSITION=120 ,EVEN-PAGE-P0SITI0N=1.   FORMAT= 
NOREDUCE  is  equivalent  to  coding  the  three  parameters  PAGE-SIZE=46, 
ODD-PAGE-POSITION=98,EVEN-PAGE-POSITION=l.   The  FORMAT  option  is  decoded 
as  if  the  three  parameters  were  present;  hence,  the  supervisor  and  called 
programs  do  not  need  to  check  for  this  option. 

Table  numbering  options  —  Many  tables  in  the  Federal  Aid  Roadlog  report 
have  a  table  number  printed  at  the  top.   The  user  may  have  this  identification 
generated  by  coding  TABLE -NUMB ER=nn  on  a  command.   Each  page  (if  the  summary 
generates  more  than  one  page)  must  have  the  table  number  printed.   Table 
numbering  continues  from  one  command  to  the  next,  much  like  page  numbering. 
However,  each  page  produced  by  a  single  program  contains  the  same  identifica- 
tion.  The  table  number  is  incremented  before  the  next  program  begins  to 
execute.   TABLE-NUMBER=STOP  can  be  coded  to  suppress  table  numbering.   The 
decoder  places  the  number  nn  in  columns  21-22  of  the  instruction.   If  TABLE- 
NUMBER=STOP  is  coded,  column  21  is  set  to  "X."  The  supervisor  must  keep  track 
of  the  current  table  number.   If  the  table  number  parameter  is  not  coded  on 
a  command,  the  supervisor  must  supply  the  present  table  number,  if  table 
numbering  is  in  effect.   If  TABLE-NUMBER=STOP  is  coded,  the  supervisor  must 
note  this,  and  blank  out  the  table  number  field.   The  called  program  must 
check  each  time  it  begins  a  new  page  whether  a  table  number  is  to  be  printed. 
After  the  program  has  completed  execution,  it  must  increment  the  table  number, 
and  return  the  value  to  the  supervisor . 

Top  margin  option  —  The  user  may  cause  an  additional  top  margin  to  be 
printed  at  the  top  of  each  page.   This  is  done  by  specifying  TOP-MARGIN=nn 
on  a  command.   The  decoder  places  the  value  coded  in  columns  11  and  12.   The 
supervisor  need  not  examine  this  field,  as  the  top  margin  option  is  never 
carried  from  one  command  to  another.   The  called  program  must  examine  this 
field,  and  print  nn  blank  lines  at  the  top  of  each  page. 

PAGE-EJECT=SUPPRESS  option  —  This  option  is  used  when  two  small 
summaries  are  desired  on  the  same  page.   (Normally,  the  supervisor  sets  the 
page-position  field  equal  to  the  page-size  field  to  force  the  output  on  a  new 
page) .   The  called  programs  must  return  the  page  position  of  its  last  line 
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of  output  for  the  PAGE-EJECT  option  to  work.   The  decoder  places  the  character 
"S"  in  column  23  of  the  instruction.   The  supervisor  then  copies  the  page- 
position  returned  from  the  previous  program  into  the  page-position  field. 
The  called  program  must  examine  column  23  if  page  numbering  is  in  effect,  as 
the  page  number  should  not  be  printed  until  a  new  page  starts. 

Setting  default  values  —  When  a  number  of  programs  will  utilize  the 
same  values  of  page-size  or  other  parameters,  it  is  easier  to  set  a  default 
value  for  a  system  execution  rather  than  coding  the  values  on  each  command. 
This  is  done  by  specifying  SYS-PARAM  as  the  program  name,  and  coding  any  of 
the  parameters  PAGE-SIZE,  ODD-PAGE-POSITION,  or  EVEN-PAGE-POSITION.  TABLE- 
NUMBER  and  PAGE-NUMBER  may  also  be  coded  to  start  or  terminate  numbering  of 
pages  and  tables.   For  example,  if  the  user  supplies  the  command: 

: SYS-PARAM, PAGE-SIZE=40 ,EVEN-PAGE-P0SITI0N=5 ,PAGE-NUMBER=3 

the  page-size  default  value  is  set  to  40  and  the  even-page-position  default 
value  set  to  5.   The  odd-page-position  default  is  not  altered.   Page  numbering 
(if  not  specified  otherwise  on  the  next  command  during  the  same  system 
execution)  will  commence  at  number  3  when  output  is  generated  by  a  subsequent 
program.   The  status  of  table  numbering  is  not  altered.   The  decoder  must 
place  an  "X"  in  column  1  (and  blanks  in  columns  2-4)  to  indicate  SYS-PARAM. 
The  supervisor  will  not  call  in  a  program  when  this  name  is  present,  as  it 
must  handle  default  settings  itself.   The  code  is  thus  internal  to  the 
supervisor. 

Program  Descriptions 

This  section  presents  descriptions  of  the  HIS  supervisor  and  command 
decoder.   The  load  modules  of  each  of  these  programs  are  located  in  cataloged 
library  HIS.LOADLIB.   The  load  module  names  are  given  with  the  program 
description. 
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Supervisor  — 


Load  Module  Name  .  .  . 

Language   . 

DD  Statements  Utilized 


SUPER 

.  BAL 

INSTRCT  —  instructions 
STEPLIB  —  location  of  load  modules 
for  execution 


When  invoked,  the  first  act  of  the  supervisor  is  to  load  and  execute  the 
comma1  J  decoder  (entry  point  name  DECODE).   The  decoder  reads  the  user's 
commands,  decodes  them  into  instructions,  and  places  them  in  a  temporary  disk 
file,  defined  by  DD  statement  INSTRCT.   The  record  length  of  this  file  is 
100  characters.   After  the  decoder  has  finished  its  task,  the  supervisor 
again  receives  control.   It  must  read  each  instruction,  perform  any  processing 
required  to  formatting  options,  set  up  linkage  to  the  instruction  for  the 
called  program,  and  load  and  execute  the  appropriate  program.   (If  the  load 
module  name  specified  is  "X,"  no  program  is  loaded,  as  the  program  SYS-PARAM 
was  specified.)   The  requirements  for  setting  up  formatting  options  has 
already  been  described.   The  first  four  characters  of  the  instruction  comprise 
the  program  name.   Because  the  LOAD  macro  used  to  load  the  program  into 
storage  requires  an  eight-byte  field,  these  characters  are  moved  into  a 
double-word  ("ENTRY")  prior  to  issuing  the  LOAD  macro.   After  executing  the 
program,  the  supervisor  must  retain  the  returned  values  of  the  page  number, 
page  position,  and  table  number  fields.   When  the  end-of-file  condition  is 
raised  on  INSTRCT,  HIS  execution  terminates.   Linkage  of  the  instruction  to 
the  called  program  follows  the  System/360  OS  convention  for  passing  a  parameter 
to  a  main  program.   Register  1  points  to  a  parameter  list,  having  one  entry. 
The  high-order  bit  is  1  to  indicate  the  last  entry.   The  remainder  of  the 
full-word  entry  points  to  the  instruction  (preceded  by  a  half-word  control 
field,  indicating  the  length  as  being  100  characters).   This  linkage  is 
depicted  in  Figure  2-1-2.   Following  is  the  program  listing  for  the  supervisor: 
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4     BYTES 


REG.     I 


4     BYTES 


INSTRUCTION 
*■ 


too 


}□ 


hr!.-r+ 


100 


BYTES  BYTES 


Figure  2-1-2.   Linkage  of  instructions  to  called  programs 


-13- 


*  HIS  SUPERVISOR 


1 
2 
3 
4 
5 
6 
7 
8 
9 
10 
11 
12 
13 
14 
15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 
39 
40 
41 
42 
43 
44 
45 
46 
47 
48 
49 
50 
51 
52 
53 
54 
55 
56 
57 
58 


*  HIS  SUPERVISOR 
SUPER     START 

PRINT  NOGEN 
BEGIN     EOU    * 
PRIME 

*  LOAD  ANO  EXECUTE  DECODER  ROUTINE 
* 

LR  2,1  SAVE  CONTENTS  OE  Rl 

LOAD  EP=DECODE  RETRIEVE  LOAD  MODULE  "DECCDE" 

LR  1,2  RESTORE  Rl 

LR  15,0  ADDR    OF    DECODER    ENTRY    POINT 

8ALR  14,15  TRANSFER    CONTROL    TO    DECODER 

DELETE  EP=DECODE  FREE    CORE    USED    BY    DECODER 

OPEN  (INSTRCT)  FILE    CONTAINS    DECODED    COMMANDS, 
* 

*  MAIN    EXECUTION    LOOP    BEGINS    HERE 

* 

READINST  EQU    * 

GET    INSTRCT, INSTR  READ  ONE  INSTRUCTION 

* 

*  PAGE    NUMBERING    OPTION. 

*  USER    MAY    SPECIFY: 

*  1.  PAGE-NUMBER=STOP     CX'     IN    COL.     15,     BLANKS     IN    COL.     16-19) 

*  2.  PAGE-NUMBER=N     (N     IN    COL.     15-18,     BLANK     IN    COL.     19) 

*  3.  PAGE-NUMBER=$*N    (N    IN    COL.     15-18,     '$'     IN    COL.     19) 
* 

*  CASE     l:       NO    PAGE-NUMBER    PARAMETER    PRESENT. 

*  "PAGENMBR"    CONTAINS    BLANKS    IF    PAGE    NUMBERING    IS    NOT     IN    EFFECT. 

*  "PAGENMBR"    CONTAINS    CURRENT    PAGE    NUMBER     IF    PAGE    NUMBERING     IS    IN 

*  EFFECT. 

CLC  INSTR+14(4) ,=C«     •  IS  PARAMETER  PRESENT? 

BNE  PAGE05  BR  IF  PRESENT 

MVC  INSTR+14(4) , PAGENMBR  BLANKS  OR  PAGE  NUMBER  FROM 

B  ENDPAGE  PREVIOUS  PROGRAM 

* 

*  CASE  2:   PAGE-NUMBER=STOP.   REPLACE  «X«  WITH  BLANK. 

* 

PAGE05    EQU  * 

CLI  INSTR  +  ^C'X'  PAGE-NUMBER  =  STOP? 

BNE  PAGE10  BRANCH  IF  NO 

MVI  INSTR+15,C«  ■  BLANK  OUT  PAGE-NUMBER  FIELD 

B  ENDPAGE 
* 

*  CASE  3.   PAGE-NUMBER=N.   NO  CHANGE  NEEDS  TO  BE    MADE. 

PAGE10    EOU  * 

CLI  INSTR  +  18  ,C  •$'  PAGF-NUMBER  =  $  +  N? 

BNE  ENDPAGE  BRANCH  IF  PAGE-NUM8ER=N  FORM 

* 

*  CASE  4.   PAGE-NUMBER=$+N.   ADD  CONTENTS  OF  PAGENMBR  TO 

*  COL.  15-18  (BOTH  ARE  IN  CHARACTER  FORMAT) 

* 

MVN  Z0N1, PAGENMBR  CONVERT  TO  ZONED  DECIMAL 

MVN  Z0N2, INSTR+14  CONVERT  TO  ZONED  DECIMAL 

PACK  PACK1,Z0N1  CONVERT  TO  PACKED  DECIMAL 

PACK  PACK2,Z0N2  CONVERT  TO  PACKED  DECIMAL 
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*  HIS  SUPERVISOR 


59 

60 

61 

62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

12 

73 

74 

75 

76 

77 

78 

79 

80 

81 

82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 

100 

101 

102 

103 

104 

105 

106 

107 

108 

109 

110 

111 

112 

113 

114 

115 

116 


AP  PACK2,PACK1  PERFORM  ADDITION  IN  PACK2 

UNPK  ZON2,PACK2  CONVERT  TO  ZONED  DECIMAL 

MVN  INSTR+14(4) ,Z0N2  RETURN  TO  INSTR  (CHAR  FORMAT) 

ENDPAGE   EQU  * 

* 

*  TABLE  NUMBERING  OPTION. 

*  USER  CODED  T ABL F-NUMBER=N  OR  T ABL E-NUMBER=STOP 
* 

*  CASE  1.   TABLE-NUMBER=STOP.   BLANK  OUT  TABLF-NUMBER  FIELD. 

* 

CLI    INSTR-*-20,C,X' 

BNE    TABL05  B  IF  NOT  TABLE-NUMBER=STOP 

MVI    INSTR  +  20,C  '  BLANK  OUT  FIELD 

B      ENDTABL 

* 

*  CASE  2.   TABLE-NUM3ER=N.   NO  CHANGE  REQUIRED. 

TABL05    EQU  * 

CLC  INSTR+20(2),=C'   ' 

BNE  ENDTABL  BRANCH  IF  TABLE-NUMBER=N 

* 

*  CASE  3.   NO  PARAMETER  CODED. 

*  "TABLNMBR"  CONTAINS  BLANKS  IF  TABLE  NUMBERING  NOT  IN  EFFECT. 

*  "TABLNMBR"  CONTAINS  ONE  PLUS  THE  PREVIOUS  TABLE  NUMBER  IF  TABLE 

*  NUMBERING  IS  IN  EFFECT. 

MVC    INSTR>20<2>, TABLNMBR 
ENDTABL   EQU    * 

* 

*  PAGF-SIZE  OPTION. 

*  USER  CODED  PAGE-SIZE=N.   VALUE  CODED  IN  IS  COL.  7-8  OF  INSTR. 

*  IF  NUT  CODED,  "PAGES  IZE"  CONTAINS  DEFAULT  VALUE  TO  BE  USED. 

CLC  INSTR  +  6(2)  ,  =  C   • 

BNE  *+10  B  IF  PARAMETER  IS  PRESENT 

MVC  INSTR*6(2) fPAGESIZE       FILL  IN  DEFAULT  VALUE 
* 

*  PAGE-EJECT=SUPPRESS  OPTION. 

*  IF  NOT  PRESENT,  SET  PAGE-POSITION  FIELD  EQUAL  TO  PAGE-SIZE  FIELD 

*  IN  ORDER  TO  FORCE  OUTPUT  ON  'NEW  PAGE. 

*  IF  PRESENT,  SET  PAGE-POSITION  FIELD  EQUAL  TO  VALUE  RETURNED  FROM 

*  PREVIOUS  PROGRAM. 

CLI  INSTR*22,C'S*  PAGE-E JECT=SUPPRESS? 

BNE  *+14  BRANCH  IF  NOT  PRESENT 

MVC  INSTR+8I 2) , POSITION  VALUE  RETURNED  FROM  PREV  PGM 

B  *+10 

MVC  INSTR+8I2), INSTR+6  USE  PAGE-SIZE  FIELD 

*  ODD-PAGE-POSITION  OPTION. 

*  USFR  CODES  0DD-PAGE-P0S1TI0N=N 

*  N  IS  DECODED  INTO  COL.  73-75 

*  IF  NOT  PRESENT,  USE  DEFAULT  VALUE  IN  "ODDPOS" 
* 

CLC    INSTR+72(3),=Cf    • 

BNE    *+10  BRANCH  IF  OPTION  PRESENT 

MVC    INSTR+72I3), ODDPOS        DEFAULT  VALUE 


* 
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117 
118 
119 
120 
121 
122 
123 
124 
125 
126 
127 
128 
129 
130 
131 
132 
133 
134 
135 
136 
137 
138 
139 
140 
141 
142 
143 
144 
145 
146 
147 
148 
149 
150 
151 
152 
153 
154 
155 
156 
157 
158 
159 
160 
161 
162 
163 
164 
165 
166 
167 
168 
169 
170 
171 
172 
173 
174 


EVEN-PAGE-POSITION  OPTION. 

USER  COOED  EVEN-PAGE-POSITION=N 

N  IS  DECODED  INTO  COL  76-78 

IF  NOT  CODED,  USE  DEFAULT  VALUE 


IN  "EVENPOS" 


CLC    INSTR+75(3),=CI    ■ 

BNE    *+10 

MVC    INSTR+75I3), EVENPOS 


BRANCH  IF  OPTION  PRESENT 
USE  DEFAULT  VALUE 


AT  THIS  POINT,  ALL  FORMATTING  OPTIONS  HAVE  BEEN  PROCESSED. 

IF  PROGRAM  SPECIFIED  WAS  SYS-PARAM  (INTERNAL  NAME  •XM,  DEFAULT 

VALUES  ARE  TO  BE  SET. 


CLC    INSTR(2) ,=C'X 
BE     SYSPARAM 


SYS-PARAM  PROGRAM? 
BRANCH  IF  YES 


FIRST  FOUR  CHARACTERS  OF  INSTR  GIVE  THE  NAME  OF  THE  LOAD  MODULE 
TO  BE  LOADED  AND  EXECUTED.   IF  THE  LOAD  MODULE  DOES  NOT  EXIST 
IN  THE  STEP  OR  SYSTEM  LIBRARIES,  THE  JOB  WILL  ABEND  WITH 
SYSTEM  COMPLETION  CODE  306. 


MVC 


£NTRY<4) , INSTR 


PROGRAMS  "SURF-TYPE"  AND  "SUMMARY-BY-ROUTES"  REQUIRE 
ADDITIONAL  PROCESSING  TO  DETERMINE  LOAD  MODULE  NAME. 


CLC  INSTR(2) ,=C,ND« 

BE  SURFTYPE 

CLC  INSTR<3) ,=C'NCR» 

BE  SUMLOCN 


:SURF-TYPE? 

: SUMMARY-BY-LOCATION? 


* 

*  RETRIEVE  LOAD  MODULE 

* 

LOADIT 


EQU  * 

LOAD  EPLOC=ENTRY  ENTRY  ADDR  RETURNED  TO  RO 

SET  UP  LINKAGE  TO  INSTRUCTION  AND  PASS  CONTROL 

LA  1,INSTRPTR 

LR  15,0 

BALR  14,15 

FREE  STORAGE  AND  SAVE  RETURNED  VALUES  OF  FORMATTING  PARAMETERS 


DELETE  EPLOC=ENTRY 
MVC    PAGENMBR,INSTR+14 
MVC    POSIT  ION, INSTR* 8 
MVC    TABLNMBR, INSTR+20 
B      READINST 

:SURF-TYPE  —  SET  UP  LOAD  MODULE  NAME 


SAVE  PAGE  NUMBER 

SAVE. PAGE  POSITION 

SAVE  TABLE  NUMBER. 

GET  NEXT  INSTRUCTION  AND 

EXECUTE  IT. 


URFTYPt  EQU 
MVI 
CLI 
BNE 
CLI 


ENTRY*3,C     ■ 
INSTR+3,C»  i" 
LOADIT 
INSTR+5,C,L' 


SUMMARY=RTE-NO? 
BRANCH  IF  NO 
DATA=ILOOP? 
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*  HIS  SUPERVISOR 


175 
176 
177 
178 
179 
180 
181 
182 
183 
184 
185 
186 
187 
188 
189 
190 
191 
192 
193 
194 
195 
196 
197 
198 
199 
200 
201 
202 
203 
204 
205 
206 
207 
208 
209 
210 
211 
212 
213 
214 
215 
216 
217 
218 
219 
220 
221 
222 
223 


BE  LOADIT  BRANCH  IF  YES 

MVI  ENTRY-i^C  1' 

B  LOAOIT 

* 

*  :SUMMARY-BY-LOCATION  —  SET  UP  LOAD  MODULE  NAME 

* 

SUMLOCN   EQU  * 

MVC  ENTRY+3< 1) ,INSTR+5        DATA  CODE  FIELD 

B  LOADIT 

* 

*  :SYS-PARAM  PROGRAM  —  SET  DEFAULT  VALUES 

* 

SYSPARAM  EQU  * 

MVC  PAGES IZE, INSTR+6  STORE  PAGESIZE  DEFAULT 

MVC  ODDPOS, INSTR+72  ODD-PAGE-POSITION  DEFAULT 

MVC  EVENP0S,INSTR+75  EVEN-PAGE-POSITION  OEFAULT 

MVC  PAGENMBR, INSTR+14         SAVE  PAGE  NUMBER 

MVC  TABLNMBR,INSTR+20         SAVE  TABLE  NUMBER 

B  READINST  GET  NEXT  INSTRUCTION 

* 

*  COME  HERE  AFTER  ALL  INSTRUCTIONS  HAVE  BEEN  EXECUTED. 

* 

ENDFILE   EQU  * 

CLOSE  (INSTRCT) 

TERME 
* 

*  VARIABLE  DECLARATIONS  * 

PAGESIZE  DC  C'601  INITIAL  DEFAULT  VALUE 

ODDPOS    DC  C»120«  INITIAL  DEFAULT  VALUE 

EVENPOS   DC  C'120'  INITIAL  DEFAULT  VALUE 

POSITION  DC  C'991  INIT  VALUE  —  START  NEW  PAGE 

PAGENMBR  DC  C     ■  INIT  VALUE  —  NO  PAGE  NUMBERS 

TABLNMBR  DC  C   •  INIT  VALUE  —  NO  TABLE  NUMBERS 

CNOP  2,4 

PARAMTR   DC  H'100'  LENGTH  OF  PARAMETER  PASSED  TO 

INSTR     DS  CL100  CALLED  PROGRAM  IS  100  CHAR 

ENTRY     DC  CL8«  •  FOR  LOAD  MODULE  NAMES 

DS  OF  FULLWORD  BOUNDARY 

INSTRPTR  DC  X«30» 

DC  AL31PARAMTR) 

Z0N1      DC  ZL4»C«  FOR  DATA  CONVERSION 

Z0N2      DC  ZL4'0«  FOR  DATA  CONVERSION 

PACK1     DS  PL3  FOR  DATA  CONVERSION 

PACK2     DS  PL3  FOR  DATA  CONVERSION 

INSTRCT   DCB  DSORG=PS ,MACRF=GM, DDNAME= INSTRCT ,EODAD=ENDF I LE 

END  BEGIN 
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Command  decoder  — 

Load  Module  Name DECODE 

Language BAL 

DD  Statements  Utilized  PRINTER  —  printer  output 

PROGTBL  —  table  of  program  names 

INSTRCT  —  instructions 

SYSIN   —  user-supplied  commands 

The  command  decoder  has  the  task  of  translating  user-supplied  commands 
into  the  more  easily  processed  instruction  format.   Each  command  has  the 
general  format: 

:pgmname,keyword=option, . . . 

The  program  name  may  be  up  to  20  characters  in  length.   The  keyword  may  be 
any  length,  but  only  the  first  10  characters  are  examined.   The  option  fields 
are  limited  to  40  characters.   Load  module  names  are  limited  by  OS  to  eight 
characters;  the  HIS  instruction  format  limits  HIS  load  module  names  to  four 
characters.   Hence,  a  conversion  must  be  made  from  the  longer  "external" 
program  name  coded  on  the  command  to  an  "internal"  name  of  four  or  fewer 
characters.   A  conversion  table  giving  each  of  the  allowable  external  names 
and  the  corresponding  internal  names  is  stored  on  disk  (or  other  medium) , 
and  is  defined  by  DD  statement  PROGTBL.   Each  of  the  records  in  the  table 
is  eighty  bytes  in  length  (to  allow  card  input) ,  containing  an  external  name 
in  columns  1  through  20,  and  an  internal  name  in  columns  21  through  24.   The 
decoder  begins  its  execution  by  reading  the  program  table  into  a  core  array. 
As  the  table  is  read,  it  is  printed  for  reference  by  the  user  when  the  table 
must  be  updated.   After  the  program  table  is  read,  the  decoder  can  begin 
decoding  the  commands.   Each  command  is  tested  to  ensure  a  colon  as  the  first 
character.   A  character-by-character  search  is  then  performed  to  find  the 
first  blank  or  comma  —  the  first  such  character  terminates  the  program  name. 
The  program  name  is  moved  into  location  "PGM,"  and  padded  with  blanks  if 
necessary  to  fill  20  characters.   The  name  is  then  compared  with  each  entry 
in  the  program  table,  and  the  proper  internal  name  substituted  into  the 
instruction.   If  no  match  is  found,  the  first  four  characters  of  the  program 
name  coded  on  the  command  are  used  as  the  internal  name;  this  facility  allows 
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the  testing  of  programs  not  yet  entered  into  the  program  table  by  coding  the 
internal  name  on  a  command.   For  each  parameter  present  on  the  command,  the 
keyword  is  retrieved  (in  the  same  character-by-character  method  used  to 
retrieve  the  program  name),  and  placed  into  "KEYWORD."  The  option  is 
retrieved  and  placed  into  "OPTION."  The  keyword  is  then  searched  against 
a  table  of  keywords  (lines  616-642  in  the  listing).   If  no  match  is  found, 
an  error  message  is  printed.   Otherwise,  a  branch  table  is  constructed  to 
branch  to  a  routine  to  decode  the  parameter  (lines  189-216) .   A  blank 
following  any  parameter  or  program  name  terminates  the  command.   The  completed 
instruction  is  then  written  (lines  524-530)  into  the  instruction  file,  and 
printed  in  the  command  listing.   After  all  the  commands  have  been  decoded, 
the  instruction  and  other  files  are  closed,  and  return  is  made  to  the 
supervisor. 

The  program  listing  for  the  command  decoder  follows: 
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♦HIS  COMMAND  DECODER  ROUTINE 


L 


1 

2 

3 

4 

5 

6 

7 

8 

9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 

21 

22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 


*  HIS  COMMAND  DECODER  ROUTINE 
DECODER 


START 
PRINT 
BEGIN     EQU 

PRIME 
BALR 
USING 
LA 
LA 

OPEN 
PUT 
PUT 
READ  TABLE 
INTERNAL 


NOGEN 
* 

11,0 
*t lit  12 

12.20481 11) 

12.20481 12) 

(TABLE,, PR NT, (OUTPUT) ) 
PRNT,P1 
PRNT,P2 

OF  PROGRAM  NAMES  FOR 
NAMES. 


PROGRAM 
HEADING 
BLANK  LINE 
CONVERSION  FROM  EXTERNAL 


TABLE  &  PRINTER  OUTP 


TO 


FORMAT    OF    TABLE     ENTRIES: 

COL       1-20  EXTERNAL    NAME 

COL    21-24  INTERNAL    NAME 

*  COL    25-80  NOT    PROCESSED    — 

LA  3, EXTERNAL 

LA  4, INTERNAL 

LA  5,0 

LA  6,50 

PROGLOOP    EQU  * 

GET  TABLE 

MVC  0(20, 3), 0(1) 

MVC  0(4,4),20(  1) 

MVC  P4+5(80) ,0(  1) 

PUT  PRNT,P4 

LA  3,20(3) 

LA  4,4(4) 

LA  5,1(5) 

BCT  6, PROGLOOP 

CLOSTABL  EQU  * 

CLOSE  (TABLE) 

STH  5,PR0GNU  NUMBER 

*  OPEN  FILES  FOR  COMMAND  INPUT  AND  INSTRUCTION 

OPEN  (SYSIN, , INSTRCT, (OUTPUT) ) 
* 

*  MAIN  EXECUTION  LOOP  BEGINS  HERE 
* 
READCARD 


(20  CHARS  MAX  LENGTH) 

(4  CHARS  MAX  LENGTH) 

MAY  CONTAIN  ANY  CHARACTERS 

ADOR  OF  EXTERNAL  NAME  ARRAY 
ADDR  OF  INTERNAL  NAME  ARRAY 
COUNTS  NUMBER  OF  TABLE  ENTRI 
50  ENTRIES  MAXIMUM  ALLOWWED 


f 
- 

r 
r 

[ 


[ 


READ    A     TABLE    ENTRY 
MOVE    EXT    NAME    TO    EXT 
MOVE     INT    NAME    TO 
PRINT    THE    RECORD 


INT 


ARRAY 
ARRAY 


R3  = 
R4  = 
R5    = 


R3 
R4 
R5 


20 

4 

1 


COME    HERE    AT    END-OF-FILE 


OF  ENTRIES 
OUTPUT 


PROCESSED 


PRNTLINE 


EQU  * 

GET  SYSIN 

LR  3,1 

NI  CHARCNTR  +  ^X'OO' 

MVC  P2+5(80> ,0(3) 

CLI  PAGECNTR+1, X' 38' 

BNH  PRNTL INE 

PUT  PRNT,P1 

MVI  PAGECNTR+1, X • 00 • 

EQU  * 

PUT  PRNT,P2 

LH  4,PAGECNTR 

LA  4,2(4) 

STH  4,PAGECNTR 

SAL  14,GETCHR 

CLI  CHAR,C'>' 

BE  READCARD 


READ  A  COMMAND 

R3  =  ADDR  OF  COMMAND 

RESET  COUNTER 

PRINT  THE  COMMAND 

PAGE  FULL? 

BRANCH  IF  NO 

HEADING 

RESET  PAGE  COUNTER 


PAGECNTR  =  PAGECNTR  +  2 


GET  FIRST  CHARACTER 
COMMENT  CARD? 
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*  HIS  COMMAND  DECODER  ROUTINE 


59 

60 

61 

62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 

80 

81 

82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 

100 

101 

102 

103 

104 

105 

106 

107 

108 

109 

110 

111 

112 

113 

114 

115 

116 


CLI  CHAR,C':« 

BE  GETPGM 

NOCOLON   EQU  * 

MVC  P3+5I20) ,*+!0 

B  PRNTERR 

DC  CL20'COLON  MISSING* 


FIRST  CHARACTER  MUST  BE  COLON 


PRINT  ERROR  MESSAGE 


*  RETRIEVE  PROGRAM  NAME 

GETPGM    EQU 

MVI 

MVC 

LA 

LA 
GETPGM05  EQU 


* 

PGM,C  ' 

PGM>1(20),PGM 

4,21 

5,  PGM 

* 

bal  14,getchr 

cli  <:har,c»    • 

be  havepgm 

cli  char,c',* 

be  havepgm 

MVC  0(1, 5), CHAR 

LA  5,1(5) 

BCT  4,GETPGM05 

MVC  P3+5(20) ,*  +  10 

B  PRNTERR 

DC  CL20'PGM  NAME  TOO  LONG* 


PGM  =  BLANKS 

MAX  PGM  NAME  LENGTH 


GET  NEXT  CHARACTER 
BLANK/COMMA  TERMINATES  NAME 


BUILD  NAME  IN  PGM 
INCREMENT  R5 

PRINT  ERROR  MESSAGE 


*  SEARCH  EXTERNAL  NAME  ARRAY  FOR  PROGRAM  NAME 

* 

4, EXTERNAL  ADDR  OF  EXT  NAME  ARRAY 

5,  INTERNAL  ADDR  OF  INT  NAME  ARRAY 

6,PR0GN0  NO.  OF  ENTRIES  IN  TABLE 

PGM(20),0(4)  COMPARE  NAME  TO  ARRAY  ENTRY 

FOUNDPGM 

4,20(4)  R4  =  R4+20 

5,4(5)  R5  =  R5+4 

6,HAVEPGM1 
IF  NAME  IS  NOT  FOUND  IN  THE  TABLE,  USE  THE  FIRST  FOUR  CHARACTERS 
OF  THE  NAME  CODED  ON  THE  COMMAND  FOR  INTERNAL  NAME 
MVC    INSTR(4),PGM 
B      FOUNDPGM+6 


HAVEPGM   EQU 
LA 
LA 
LH 

HAVEPGM1  EQU 
CLC 
BE 
LA 
LA 
BCT 


PROGRAM  NAME  FOUND  IN  TABLE.   R5  POINTS  TO  INTERNAL  NAME 


INSTRI4) ,0(5) 

INSTR+4,C»  ■ 
INSTR+5I95), INSTR+4 


FILL  REST  OF  INSTR  WITH  BLANKS 


* 

FOUNDPGM  EQU 

MVC 

MVI 

MVC 
* 

*  LOOP    FOR    DECODING    PARAMETERS. 

*  EACH    PARAMETER     IS    WRITTEN    AS    KE YWORD=OPT ION 

* 

PARMLOOP  EQU  * 

CLI  CHAR,C»  •  LAST  PARM  FOLLOWED  BY  BLANK 

BE  WRITINST 

MVI  KEYWORD, C*     '  SET  KEYWORD,  OPTION  TO  BLANKS 
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*  HIS  COMMAND  DECODER  ROUTINE 


r 


117 

118 

119 

120 

121 

122 

123 

124 

125 

126 

127 

128 

129 

130 

131 

132 

133 

134 

135 

136 

137 

138 

139 

140 

141 

142 

143 

144 

145 

146 

147 

148 

149 

150 

151 

152 

153 

154 

155 

156 

157 

158 

159 

160 

161 

162 

163 

164 

165 

166 

167 

168 

169 

170 

171 

172 

173 

174 


*  NOTE 
GETKEY 


GETKEY05 


*  ONLY 


MVC  KEYWORD+U  50)  .KEYWORD 

BAL  14.GETCHR 

CLI  CHAR.C*  • 

BE  CONTINUE 

ONLY  FIRST  TEN  CHARS  OF  KEYWO 

EQU  * 

LA  4, KEYWORD 

LA  5,10 

EQU  * 

CLI  CHAR.C^1 

BE  HAVEKEY 

MVC  0(1, 4), CHAR 

LA  4,1(41 

BAL  14,GETCHR 

LTR  15,15 

BNZ  KEYERR 

BCT  5,GETKEY05 
COME  HERE  IF  KEYWORD  IS  LONGER 


GET  NEXT  CHARACTER 
CONTINUATION  CARD  REQUIRED? 

RD  ARE  EXAMINED 


MAX  NUMBER  CHARS  TO  BE  READ 

TERMINATES  KEYWORD 

STORE  CHAR  INTO  KEYWORD 
INCREMENT  R4 
GET  NEXT  CHARACTER 
END  OF  CARD?  -  ERROR 

THAN  10  CHARACTERS.   IGNORE 


r 


i 

L 

r 

L 

[ 

L 


*  THE  REMAINING  CHARACTERS. 


GETKEY10 


KEYERR 


EQU 

CLI 

BE 

BAL 

LTR 

BZ 

EQU 

MVC 

B 

DC 


CHAR,C»=» 

HAVEKEY 

14.GETCHR 

15,15 

GETKEY10 

* 

P3+5(20) ,*+10 

PRNTERR 

CL20* INVALID  KEYWORD* 


GET  NEXT  CHARACTFR 
END  OF  CARD?  -  ERROR 


PRIN  ERROR  MESSAGE 


*  AFTER  RETRIEVING  KEYWORD,  OBTAIN  OPTION 
HAVEKEY 


EQU  * 

LA  4, OPTION 

LA  5,41 

GETOPT05    EQU  * 

BAL  14,GETCHR 

LTR  15,15 

BZ  GET0PT10 

MVI  CHAR,Cf  ■ 

B  HAVEQPT 

GET0PT10  EQU  * 

CLI  CHARtC*  ' 

BE  HAVEOPT 

CLI  CHAR,C»,' 

BE  HAVEOPT 

MVC  0(1, 4), CHAR 

LA  4,1(4) 

BCT  5,GETOPT05 

OPTERR    EQU  * 

MVC  P3*5(20)  ,**10 

B  PRNTERR 

DC  CL20' INVALID  OPTION' 
* 

*  AFTER  OBTAINING  KEYWORD  AND  OPTION, 

*  THE  LAST  ENTRY  IN  THE  KEYWORD  TABLE 
* 

HAVEOPT   EQU  * 


MAX  OPTION  LENGTH  +  1 

GET  NEXT  CHARACTER 
TEST  FOR  END  OF  CARD 
BRANCH  IF  NOT  END 
FLAG  END  OF  COMMAND 


BLANK/COMMA  TERMINATES  OPTION 


BUILD  OPTION 
INCREMENT  R4 


PRINT  ERROR  MESSAGE 


SEARCH  FOR  KEYWORD  IN  TABLE 
IS  BLANKS 
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*  HIS  COMMAND  DECODER  ROUTINE 


175 
176 
177 
178 
179 
180 
181 
182 
183 
184 
185 
186 
187 
188 
189 
190 
191 
192 
193 
194 
195 
196 
197 
198 
199 
200 
201 
202 
203 
204 
205 
206 
207 
208 
209 
210 
211 
212 
213 
214 
215 
216 
217 
218 
219 
220 
221 
222 
223 
224 
225 
226 
227 
228 
229 
230 
231 
232 


LA  5,KEYS 

LA  6,0 

SEARCH05  EOU  * 

CLC  0( 10,5),=CL10»  ■ 

BE  KEYERR 

CLC  0( 10,5) , KEYWORD 

BE  FOUNDKEY 

LA  5,10(5) 

LA  6,4(6) 

B  SEARCH05 


ADDR  OF  KEYWORD  TABLE 
INIT  COUNTER 

END  OF  TABLE  —  NO  MATCH  FOUND 

COMPARE  KEYWORD  TO  TABLE  ENTRY 

POINTS  TO  NEXT  TABLE  ENTRY 
INCREMENT  COUNTER 


* 
FOUNDKEY 


COME  HERE  WHEN  A  MATCH  HAS  BEEN  FOUND  IN  THE  KEYWORD  TABLE 
R6  CONTAINS  4  X  THE  NUMBER  OF  THE  KEYWORD  ENTRY 


EOU 

B 

B 

B 

B 

B 

B 

B 

B 

B 

B 

B 

B 

B 

a 

B 
B 
B 
B 
B 
B 
B 
B 
B 
B 
B 
B 
B 


*+4(6) 

FILE 

REPORT 

FUNCTION 

PHASE 

FHSUM 

SUMMARY 

MILEAGE 

LIST 

ACIDENTS 

DDNAME 

INDD 

STARTDTE 

OUTDO 

ENDDTE 

EJECT 

PAGESIZE 

TOPMRGN 

TABLNMBR 

ODDPOS 

EVENPOS 

PAGENMBR 

FORMAT 

LOCATION 

STARTKEY 

ENDKEY 

DATA 


FILE  PARAMETER.   COL  3. 


ILE 


FILE05 


EOU 

CLC 

BNE 

MVI 

B 

EOU 

MVC 

B 


0PTI0N(7)  ^C'TRUMILE1 

FILE05 

INSTR+2,C'M« 

PARMLOOP 

* 

INSTR*2( 1) , OPTION 

PARM'.OOP 


*  REPORT  PARAMETER.   COL  3. 
* 

REPORT 


EQU    * 

CLC    0PTI0N(8) ,=C«SMTABLES» 
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*  HIS  COMMAND  DECODER  ROUTINE 


233 

234 

235 

236 

237 

238 

239 

240 

241 

242 

243 

244 

245 

246 

247 

248 

249 

250 

251 

252 

253 

254 

255 

256 

257 

258 

259 

260 

261 

262 

263 

2  64 

265 

266 

267 

268 

2  69 

270 

271 

272 

273 

274 

275 

276 

277 

278 

279 

280 

281 

282 

283 

284 

285 

286 

287 

288 

289 

290 


REPORT05 
INSTR+2 tC'Q1 
PARMLOOP 
* 

INSTR+2I  i»  , OPTION 
PARMLOOP 


BNE 

MVI 

B 
REP0RT05  EQU 

MVC 

8 
* 

*  FUNCTION,  PHASE,  FHSUMMARY  PARAMETERS  —  COL  4 
* 

FUNCTION  EQU  * 

FHSUM     EQU  * 

PHASE     EQU  * 

MVC  INSTR  +  3< 1)  , OPTION 

B  PARMLOOP 
* 

*  SUMMARY  PARAMETER  —  COL  4 

SUMMARY   EQU  * 

CLC  0PTI0N(6),=C,RTE-N0» 

BE  SUM1 

CLC  0PTI0NI6)  ^C'PROJ-tf* 

BE  SUM2 

CLC  0PTI0NC6) .sC'COUNTY1 

BE  SUM3 

CLC  OPTIONm^C  CITIES' 

BE  SUM4 

CLC  0PTI0N(6),=C,YR-aLT« 

BE  SUM5 

CLC  OPTION^^C'SUP-WO' 

BE  SUM6 

CLC  0PTI0N(6),=C»YR-IMP» 

BE  SUM7 

MVC  P3+5(20) ,*+10 

B  PRNTERR  PRINT  ERROR  MESSGE 

DC  CL20'  INVALID  SUMMARY  PARM« 

SUM1      EQU  * 

MVI  INSTR+3,C,1' 

B  PARMLOOP 

SUM2      EQU  * 

MVI  INSTR+3,C'2* 

B  PARMLUCP 

SUM3      EQU  * 

MVI  INSTR  +  3,C3' 

B  PARMLOOP 

SUM4      EQU  * 

MVI  INSTR*3,C,4« 

B  PARMLOOP 

SUM5      EQU  * 

MVI  INSTR+3,C»5« 

B  PARMLOOP 

SUM6      EQU  * 

MVI  INSTR  +  3,C6' 

B  PARMLOOP 

SUM7      EQU  * 

MVI  INSTR*3,C»7' 

B  PARMLOOP 
♦ 

*  MILEAGE,  LIST,  ACCIDENTS  PARAMETERS  —  COL  5 
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L 


c 

L 

r 

L 


*  HIS  COMMAND  DECODER  ROUTINE 


291 

292 

293 

294 

295 

296 

297 

298 

299 

300 

301 

302 

303 

3d 

305 

306 

307 

308 

309 

310 

311 

312 

313 

314 

315 

316 

317 

318 

319 

320 

321 

322 

323 

324 

325 

326 

327 

328 

329 

330 

331 

332 

333 

334 

335 

336 

337 

338 

339 

340 

341 

342 

343 

344 

345 

346 

347 

348 


MILEAGE 
LIST 

ACIDENT 


*  DDNAM 

*  FIRST 
* 

DDNAME 
INDD 
STARTDT 


*  OUTDD 

*  MOVE 
* 

OUTDD 
ENDDTE 


INTO  COL  24-31 


EOU  * 

EQU  * 

S  EQU  * 

MVC  INSTR*4( 1) ,OPT ION 

B  PARMLOOP 

E,  INDD,  AND  START-DATE  PARAMETERS 
8  CHARACTERS  OF  OPTION  ARE  PLACED 

EOU  * 

EOU  * 

E  EQU  * 

MVC  INSTR-»-?3<8),  OPTION 

B  :  PARMLOOP 


AND  END-DATE  PARAMETERS 
FIRST  8  CHARACTERS  OF  OPTION  INTO  COL  32-39 

EQU  * 

EQU  * 

MVC  INSTR  +  3K8),  OPTION 

B  PARMLOOP 


*  PAGE-EJECT=SUPPRESS  OPTION 
EJECT 


EQU 
MVC 
B 


INSTR+22( 1), OPTION 
PARMLOOP 


*  2-DIGIT  NUMERIC  OPTIONS 
* 

PAGESIZE  EQU  * 

LA  4,INSTR+6 

B  NUMBER2D 

TOPMRGN   EQU  * 

LA  4,INSTR+10 

B  NUMBER2D 

TABLNMBR  EQU  * 

LA  4.INSTR+20 

CLC  0PTI0N(5) ,=C»STOP 

BNE  NUMBER2D 

MVI  INSTR+20,C,X» 

B  PARMLOOP 

NUMBER2D  EQU  * 

LA  5, OPTION 

NMBR2D05  EQU  * 

MVC  0(1,4), 1(4) 

MVC  1(1, 4), 0(5) 

LA  5,1(5) 

CLI  0(5), C  ' 

BNE  NMBR2D05 

B  PARMLOOP 
* 

*  THREE-DIGIT  NUMERIC  OPTIONS 
ODDPOS 


COL  7-8 


COL  11-12 


COL  21-22 
TABLE-NUMBER=STOP 
BRANCH  IF  NO 


FORM? 


SHIFT  LEFT 

INSERT  NEW  DIGIT 

INCREMENT  R5 

BLANK  TERMINATES  NUMBER 


EQU 
LA 


4,INSTR+72 


COL  73-75 
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*  HIS  COMMAND  DECODER  ROUTINE 


349 
350 
351 
352 
353 
354 
355 
356 
357 
358 
359 
360 
361 
362 
363 
3  64 
365 
366 
367 
368 
369 
370 
371 
372 
373 
374 
375 
376 
377 
378 
379 
380 
381 
382 
383 
384 
385 
386 
387 
388 
389 
390 
391 
392 
393 
394 
395 
396 
397 
398 
399 
400 
401 
402 
403 
404 
405 
406 


B  NUMBER3D 

EVENPOS   EQU  * 

LA  4,INSTR+75 

NUMBER3D  EQU  * 

LA  5, OPTION 

NM3R3D05  EQU  * 

MVC  0(2,41,1(4) 

MVC  2(1, 4), 0(5) 

LA  5,1(5) 

CLI  0(5), C«  • 

BNE  NMBR3005 

B  PARMLOOP 

*  PAGE-NUMBER  PARAMETER 


PAGENMBR 


PAGEN005 


rQTJ * 

CLC  0PTI0N(5) ,=C'STOP 

BNE  PAGENG05 

MVI  INSTR+14,C,X« 

B  PARMLOOP 

EQU  * 

LA  4,INSTR+14 

CLC  OPTION! 2) 9=C9$+% 

BNE  NUMBER4D 

MVI  INSTR+18,C'$' 

LA  5,OPTION+2 

B  NMBR4D05 

NUMBER4D  EQU  * 

LA  5, OPTION 

NMBR4D05  EQU  * 

MVC  0(3, 4), 1(4) 

MVC  3(1, 4), 0(5) 

LA  5,1(5) 

CLI  0(5), C  • 

BNE  NM3R4005 

B  PARMLOOP 


*  FORMA 

*  FORMA 

*  AN 

*  FORMA 

*  AN 
* 
FORMAT 


COL  76-78 


SHIFT  LEFT 

INSERT  NEW  DIGIT 

INCREMFNT  R5 

BLANK  TERMINATES  NUMBER 


PAGE-NUMBER=STOP    FORM? 
BRANCH    IF    NO 


COL  15-18 

PAGE-NUMBER=$+N  FORM? 
BRANCH  IF  NOT  $+N  FORM 
$  IN  COL  19 
INCREMENT  PAST  "$+" 


L 

r 

L 

[ 
[ 

L 


SHIFT  LEFT 

INSERT  NEW  DIGIT 

INCREMENT  R5 

BLANK  TERMINATES  NUMBER 


NOREDUCE 


T  PARAMETER 

T=REDUCE  IS  EQUIVALENT  TO  PAGE- 
D  EVEN-PAGE-P0SITI0N=1 
T=NOREDUCE  IS  EQUIVALENT  TO  PAG 
0  EVEN-PAGE-P0SITI0N=1 


EQU  * 

CLI  OPTION, C'N" 

BE  NOREDUCE 

MVC  INSTR+6C2) t=C,60l 

MVC  INSTR+72(6),=C 120001' 

B  PARMLOOP 

EQU  * 

MVC  INSTR+6(  2)  ,  =  C46' 

MVC  INSTR*72(6),=C,098001» 

B  PARMLOOP 


SIZE=60,    0DD-PAGE-P0SITI0N=120, 
E-SIZE=46,    00D-PAGE-P0SITI0N=98 


*    LOCATION    PARAMETER    —    MOVE    18    CHARACTERS    INTO    COL    40-57 

* 

LOCATIOI 


IN    EQU 
MVC 


INSTR+39( 18) .OPTION 
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*  HIS  COMMAND  DECODER  ROUTINE 


407 
408 
409 
410 
411 
412 
413 
414 
415 
416 
417 
418 
419 
420 
421 
422 
42  3 
424 
42  5 
42  6 
42  7 

42  8 
429 
430 
431 
432 
433 
434 
435 
436 

43  7 
43  8 
439 
440 
441 
442 
443 
444 
445 
446 
447 
448 
449 
450 
451 
452 
453 
454 
455 
456 
457 
458 
459 
460 
461 
462 
463 
464 


*  STARTK 
STARTKEY 


B  PARMLOOP 

EY    PARAMETER    —    MOVE    16    CHARACTERS    INTO    COL    40-55 


EOU 
MVC 
B 


INSTR+39I 16) , OPTION 
PARMLOOP 


*  ENDKEY 

* 

ENDKEY 


PARAMETER    —    MOVE     16    CHARACTERS     INTO    COL    56-71 


EOU 
MVC 

B 


INSTR*55( 16) , OPTION 
PARMLOOP 


*  CODE  F 

*  POSSIB 

*  DATA 

*  DAT 

*  INFORM 

*  INT 
* 

DATA 


OR  DECODING  DATA  PARAMETER 
LE  FORMATS  ARE: 
=INT   DATA=PRIM   DATA=SEC 
A=INT=N-N   DATA=PRIM=N-N 


DATA 
DATA  = 


ATION  MUST  BE  TRANSFORMED  INTO 
0  THE  APPROPRIATE  FILE 


=  INT«-PRIM   DATA=ALL   DATA=ILOOP 
SEC=N-N 

A  STARTING  AND  AN  ENDING  KEY 


DATAERR 


DATAALL 


DATARO 


DATAIP 


DATAI 


EQU 

CLC 

BE 

CLC 

BE 

CLC 

BE 

CLC 

BE 

CLC 

BE 

CLC 

BE 

EQU 

MVC 

B 

DC 

EQU 

MVC 

MVC 

MVI 

EQU 

CLI 

BE 

CLI 

BE 

MVC 

B 

EQU 

MVC 

MVC 

MVI 

B 

EQU 

MVC 

MVC 


0PTI0NI3 

DATAALL 

OPT  ION (8 

DATAIP 

0PTI0NI3 

DATAI 

0PTI0NI4 

DATAP 

QPTI0NI3 

DATAS 

0PTI0N(5 

DATALP 

P3+5I20) 
PRNTERR 
CL20' INV 

INSTR+39 
INSTR4-55 
INSTR+5, 

INSTR+2, 
PARMLOOP 
INSTR+2, 
PARMLOOP 
INSTR+43 
PARMLOOP 

INSTR+39 
INSTR+55 
INSTR+5, 
DATARQ 

INSTR+39 
INSTR+55 


>,=C»ALL' 

) ,=C*  INT  +  PRIM' 

)  ,=C  INT* 

) ,=C'PRIM« 

),=C»SEC» 

),=C» ILOOP* 

,*  +  10 

ALIO  DATA  PARM' 

<4),=C» 1015' 
<4),=C  S999' 

C'A' 

C»R« 
C'Q1 

m^cooo+o.ooo 


(4),=C  1015* 
(4),=C,P999I 
C»C« 


(4),=C,I015» 
(4)f=C« 1999* 


FIRST  INTERSTATE  RECORD 

FLAG  MDATA=ALL"  FORM 

FILE=ROADLOG 
BRANCH  IF  YES 

REPORT=SMTABLES  (ROADLOG  FILE) 
BRANCH  IF  YES 


FIRST  INTERSTATE  RECORD 
LARGER  THAN  LAST  PRIM  RECORD 
FLAG  "DATA=INT+PRIM"  FORM 


FIRST  INTERSTATE  RECORD 
LARGER  THAN  LAST  INT  RECORD 
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*  HIS  COMMAND  DECODER  ROUTINE 


465 
466 
467 
46  8 
469 
470 
471 
472 
473 
474 
475 
476 
477 
478 
479 
480 
481 
482 
483 
484 
485 
486 
487 
488 
489 
490 
491 
492 
493 
494 
495 
496 
497 
498 
499 
500 
501 
502 
503 
504 
505 
506 
507 
508 
509 
510 
511 
512 
513 
514 
515 
516 
517 
518 
519 
520 
52  1 
522 


DATAP 


DATAS 


DATARTI 

* 


DATARTE2 


DATARTE4 


DATARTE6 


DATARTE8 


DATALP 


CLI 

BE 

MVI 

B 

EOU 

MVC 

MVC 

CLI 

BE 

MVI 

B 

EQU 

MVC 

MVC 

CLI 

BE 

MVI 

B 

EQU 

MVC 

LA 

LA 

CLI 

BNE 

EQU 

LA 

CLI 

BE 

CLI 

BE 

MVC 

MVC 

B 

EQU 

MVC 

MVC 

LA 

EQU 

LA 

CLI 

BE 

MVC 

MVC 

B 

EQU 

MVC 

MVC 

B 

EQU 

MVC 

MVC 

MVI 

B 


OPTIO 
DATAR 
INSTR 
DATAR 

INSTR 
INSTR 
OPTIO 
DATAR 
INSTR 
DATAR 

INSTR 
INSTR 
OPTIO 
DATAR 
INSTR 
OATAR 


N+3,C«= 

TE 

♦  5,C  I« 


DATA=INT=N-N  FORM 
FILL  IN  ROUTE  NUMBERS 
FLAG  »DATA=INT»  FORM 


♦39(4), 
♦55(4), 

N^4,C«= 

TE 

♦S.C'P* 

Q 

♦39(4) , 
♦55(4), 
N^3,C»= 

TE 

♦  s.cs* 

Q 


=C»P001«      FIRST  PRIMARY  RECORD 
=C»P999»      LARGER  THAN  LAST  PRIM  RECORD 
•  DATA=PRIM=N-N  FORM 

FILL  IN  ROUTE  NUMBERS 
FLAG  "DATA=PRIM»  FORM 


INSTR^40(3), 

4, INSTR^40 

5,0PTI0N+4 

INSTR+39,C»P 

*  +  8 

* 

5,  1(5) 
0(5), C1-' 
DATARTE4 
0(5), C»  ' 
DATARTE8 
0(2, 4), 1(4) 
2(1,4) ,0( 5) 
DATARTE2 

INSTR^56(3), 
INSTR*59(9)  , 
4, INSTR+56 

* 

5,1(5) 

0(5)  ,C  ' 
DATARQ 
0(2,4), 1(4) 
2(1,4) ,0( 5) 
DATARTE6 
* 

INSTR+56(3) , 
INSTR+59(9), 
DATARQ 

* 

INSTR09(4)  , 
INSTR^55(4), 
INSTR+5,C,L' 
PARMLUOP 


=C,S20i'      FIRST  SECONDARY  RECORD 
=C,S999«      LARGER  THAN  LAST  SEC  RECORD 

•  DATA=SEC=N-N  FORM 
FILL  IN  ROUTE  NUMBERS 
FLAG  "DATA=SEC"  FORM 

COL  6  REMAINS  BLANK  FOR  THESE 
FORMS. 
=C'000»        ZERO  OUT  RTE  NO 

ADDR  OF  ROUTE  FIELD 
LOCATION  OF    NO.  SPECIFIED 

•  DATA=PRIM=N-N  —  EXTRA  CHAR 


INCREMENT  R5 

HYPHEN/BLANK  ENDS  ROUTE  NO 


r 

L 
f 


r 

L 

r 
L 

L 

[ 


SHIFT  ONE  PLACE 
INSERT  NEW  DIGIT 


X'OOO1       ZERO  OUT  ENDING  RTE  NO 
X'999+9.9991 


IGNORE  HYPHEN 

BLANK  TERMINATES  RTE  NO 

SHIFT  LEFT 
INSERT  NEW  DIGIT 

COME  HERE  WHEN  NO  SECOND  ROUTE 
INSTR+40         SPECIFIED.   USE  STARTING 
=C»999^9.999«    ROUTE  NUMBER. 


C'POOl' 
X*P999« 


FIRST  PRIMARY  RECORD 
LARGER  THAN  LAST  PRIM  ENTRY 
FLAG  "DATA=ILOOP"  FORM 


* 

*  WRITE  THE  INSTRUCTION  TO  OUTPUT  FILE 
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*  HIS  COMMAND  DECODER  ROUTINE 


523 
524 
52  5 
526 
52  7 
528 
529 
530 
531 
532 
533 
534 
535 
536 
537 
538 
539 
540 
541 
542 
543 
544 
545 
546 
547 
548 
549 
550 
551 
552 
553 
554 
555 
556 
557 
558 
559 
560 
561 
562 
563 
564 
565 
566 
567 
568 
569 
570 
571 
572 
573 
574 
575 
576 
577 
578 
579 
580 


WR 


ITINST  EOU  * 

PUT  INSTRCT  ,  INSTR 

MVC  P^  +  10( 100)  ,  INSTR 

PUT  PRNT,P5 

LH  4,PAGCCNTR 

LA  4,1(4) 

STH  4,PAGECNTR 

8  RFADCARD 


GETCHR  SUBROUTINE 

THIS  SUBROUTINE  RFTRIEVES  ONE  CHARAC 

THE  CHARACTER  IS  PLACED  IN  LOCATION 

R3  POINTS  TO  CURRENT  CHARACTER 

R14  IS  THE  LINK  REGISTER 

"CHARCNTR"  COUNTS  NUMBER  OF  CHAPACTE 

IE  ALL  80  CHARACTERS  HAVE  BEEN  PROCE 

AN)  R15  IS  SET  TO  RETURN  CODE  OF 
OTHERWISE,  R15  IS  SET  TO  ZERO. 


PRINT  THE  INSTRUCTION 
INCREMENT  PAGE  COUNTER 


* 

GFTCHR 


TER  FROM  THE  COMMAND. 
••CHAR". 


RS  PROCESSED. 

SSED,  "CHAR"  IS  SET  TO  BLANK, 
4. 


GETCHR 0  5 


EOU 

CLI 

BNE 

MVl 

LA 

BR 

EOU 

MVC 

CLI 

BNE 

MVI 

LA 

LH 

LA 

STH 

LA 

BR 


CO 
GE 
CH 
15 
14 

CH 
CH 
*  + 
CH 
3, 
15 
15 
15 
15 
14 


ARCNTR+1 ,X'4F • 
TCHR05 

AR,C   ' 
.4 


AR  f  0(  3  1 

AR.C1.' 

9 

AR,C»-« 

1(3) 

,CHARCNTR 

,1(15) 

, CHARCNTR. 

.0 


*  CODE  EGP  CONTINUATION  CARDS 

CONTINUE  ECU  * 

GET  SYS  IN 

LR  3,1 

NI  CHARCNTR4-1  ,X«00' 

MVC  P2+5(30), 0(3) 

MVI  P  2  f  C «     ' 

PUT  PRNT,P2 

MVI  P2,C'0' 

LH  4-,  PAG  EC  NT  R 

LA  4,1(4) 

STH  4,PAGECNTR 

BAL  14, GETCHR 

CLI  CHAR,C':f 

BNE  NOCOLON 


EN!)    OF    CARD? 
BRANCH     IF    NO 

ABNORMAL    RETURN    CODE 


NEXT    CHARACTER 


INCREMENT    POINTER 
INCREMF-NT    COUNTER 


NORMAL    RETURN    CODE 


SAVF    ADOR    OF    CARD 
RESFT    COUNTER 
PRINT    THE    CARD 


INCREMFNT    COUNTER 


GET    FIRST    CHARACTER 
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*  HIS  COMMANC  DECODED  ROUTINE 


581 

582 

583 

584 

585 

586 

587 

588 

589 

590 

591 

592 

593 

594 

595 

596 

597 

598 

599 

600 

601 

602 

603 

604 

605 

606 

607 

608 

609 

610 

611 

612 

613 

614 

615 

616 

617 

618 

619 

620 

621 

622 

623 

624 

62  5 

626 

627 

628 

629 

630 

631 

632 

633 

634 

635 

636 

637 

638 


L05 


*  PRINT 

* 

PRNTERR 


LA  4,79 

EQU  * 

BAL  14.GETCHR 

CLI  CHAR,C«  ' 

BNF  GETKEY 

BCT  4fL05 

MVC  P3+5(20) ,*+10 

B  PRNTERR 

OC  CL20,NULL  CONTINUATION' 

ERROR  MESSAGE 


BEGIN    SEARCH    FOR    NON-BLANK 

CHARACTER 
GET    NEXT    CHARACTER 


PRINT    ERROR    MESSAGF 


EQU 

PUT 

LH 

LA 

STH 

B 


PRNT,P3 

4,PAGECNTR 

4,1(4) 

4,PAGECNTR 

READCARD 


INCREMENT    COUNTER 


* 

*  COME 

RETURN 


HERE  WHEN  FINISHED  (EOF  ON  SYSIN) 


r 

L 

r 


L 

l 

L 

[ 
[ 
[ 


EQU 

CLOS 

TERM 


F  (PRNT, , SYSIN, , INSTRCT) 

F 


*  VARIABLES 

* 

PAGECNTR 

CHARCNTR 

KEYWORD 

OPTION 

KEYS 


DC 

DS 

DS 

DS 

EQU 

DC 

DC 

DC 

DC 

DC 

DC 

DC 

DC 

DC 

DC 

DC 

DC 

DC 

DC 

DC 

DC 

DC 

DC 

DC 

DC 

DC 

DC 


H«  60' 
H 

CLIO 
CL41 

CLIO 
CL  LO 
CLIO 
CL  10 
CLIO 
CL  10 
CLIO 
CLIO 
CLIO 
CLIO 
CLIO 
CLIO 
CLIO 
CL  10 
CLIO 
CL  10 
CLIO 
CI  10 
CLIO 
CLIO 
CLIO 
CL  10 


FILE' 

REPORT' 

FUNCTION' 

PHASE' 

FHSUMMARY' 

SUMMARY' 

MILEAGE' 

LIST' 

ACCIDENTS' 

DDNAME' 

INDD' 

START-DATF' 

OUTDD' 

END-DATE' 

PAGE-EJECT' 

PAGFS  IZE» 

TUP-MARGIN' 

TABLF-NUMBER' 

ODD-PAGE-PUSITION' 

FvrN-PAGE-PUSITION' 

PAGE-NUMBER' 

FORMAT' 
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*  HIS  COMMAND  DECOOER  ROUTINE 


639 
640 
641 
642 
643 
644 
645 
646 
647 
648 
649 
650 
651 
652 
653 
654 
655 
656 
657 
658 
659 
660 


PI 

P2 
P3 
P4 
P5 

PGM 

INSTR 

CHAR 

PROGNO 

EXTERNAL 

INTERNAL 

PRNT 

TABLE 

SYSIN 

INSTRCT 


DC 

DC 

DC 

DC 

DC 

DC 

DC 

DC 

DC 

DC 

DS 

OS 

DS 

DS 

DS 

DS 

DCB 

DCB 

DCB 

DCB 

END 


CLIO' 

CLIO' 

CLIO1 

CLIO1 

CLIO' 

CL133 

CL133 

CL133 

CL133 

CL133 

CL21 

CL100 

CL1 

H 

50CL2 

50CL4 

DSORG 

DSORG 

DSORG 

DSORG 

RECFM 

BEGIN 


LOCAT  ION' 
STARTKEY* 
ENDKEY* 
DATA' 


•1 

•0' 

•     * 
i     i 


HIS    COMMAND    DECODER1 


0 

=PS, MACRF=PM,DDN AM E=PR INTER 

=PS,MACRF=GLfDDNAME=PROGTBLtEODAD=CLOSTABL 
=PS,MACRF=GL,DDNAME=SYSIN,EODAD=RETURN 
=PS,MACRF=PM,DDNAME=INSTRCT,BLKSIZE=800,LRECL=100, 

=  FB 
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Printer  subroutine 

Object  Module  Name  PRINTX1 

Language PL/I 

DD  Statements  Utilized  PRINTER  and  SYSPRINT 

Entry  Points INIT 

EXIT 
PRINTX 
PRINTXA 
ASTER 

As  can  be  seen  from  the  description  given  of  formatting  options  available 
to  the  users  of  HIS,  a  great  burden  is  placed  on  each  program  in  the  system 
in  order  to  follow  all  the  required  conventions.   The  printer  subroutine  has 
been  provided  to  ease  this  load  when  writing  PL/I  programs  to  run  under  HIS. 
The  printer  subroutine  relieves  the  programmer  of  the  responsibilities  for 
the  PAGE-SIZE,  PAGE-NUMBER,  TABLE-NUMBER,  TOP-MARGIN,  PAGE-NUMBER-POSITION, 
and  PAGE-EJECT  options.   In  addition,  it  keeps  track  of  the  printer  location, 
advances  to  a  new  page  when  necessary,  and  can  print  page  headings  for  the 
programmer.   When  a  program  receives  control  from  the  HIS  supervisor,  the 
100-byte  instruction  is  passed  to  it  in  the  normal  System/360  conventions. 
Hence,  the  PL /I  programmer  obtains  the  instruction  by  coding: 

pgm-name:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 
DECLARE  PARM  CHAR (100) ; 

Upon  receiving  control,  the  PL/I  program  must  invoke  the  printer  routine  at 
entry  point  INIT,  passing  the  instruction.   The  actions  performed  by  INIT 
are:   1)  open  the  printer  file,  2)  move  the  first  80  bytes  of  the  instruction 
into  external  variable  INSTR,  and  3)  set  the  external  area  HEADING  to  blanks. 

In  order  to  print  a  line  of  output,  the  line  is  set  up  in  external 
variable  PRINTER,  and  the  printer  subroutine  is  invoked  at  entry  point  PRINTX. 
A  number  is  passed  to  indicate  printer  spacing.   The  numbers  0  through  8 
indicate  the  number  of  lines  to  be  skipped  before  printing  (hence,  0  causes 
the  line  to  be  printed  over  the  line  just  printed,  1  causes  single-spacing, 
etc.).   The  number  9  is  used  to  cause  a  skip  to  the  next  page.   The  sub- 
routine is  instructed  to  print  page  headings  by  placing  a  number  indicating 
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the  number  of  lines  to  be  printed  as  headings  in  column  72  of  the  instruction, 
and  placing  the  headings  in  external  array  HEADING.   An  example  program  is: 

/*  TEST  PROGRAM  SHOWING  PRINT  ROUTINE  UTILIZATION  */ 
TESTIT:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 

DECLARE  PARM  CHAR ( 100) ,  INSTR  CHAR(80)  EXT,  PRINTX  ENTRY  (PIC'Z'), 
(PRINTER, HEADING (9))  CHAR(132)  EXT, 
#_HDGS  PIC'Z'  DEF  INSTR  POS(72); 

CALL  IN  IT  (PARM)  ; 

#_HDGS  =  2; 

HEADING(l)    =    '  PAGE  HEADING' ; 

PRINTER  =    '  ONE  LINE  OF  OUTPUT ' ; 

CALL   PRINTX    (1); 

PRINTER  =  '    MORE  OUTPUT ' ; 

CALL  PRINTX  (6); 

CALL  EXIT  (PARM) ; 

END  TESTIT; 

The  programmer  has  indicated  to  the  print  routine  that  two  lines  of 
headings  will  be  required.   A  value  has  been  placed  into  HEADING(l) ,  the  first 
heading  line.   No  value  has  been  placed  into  HEADING(2) ;  this  line  will  con- 
tain blanks  because  entry  point  INIT  fills  the  heading  array  with  blanks. 
When  the  print  routine  is  first  invoked  at  entry  point  PRINTX,  a  control 
number  of  "1"  has  been  passed,  indicating  single  spacing.   However,  the 
supervisor  has  passed  values  in  the  page-size  and  page-position  fields  of  the 
instruction  indicating  that  a  new  page  must  be  started.   Hence,  the  printer 
will  be  advanced  to  a  new  page,  and  page  numbers,  table  numbers,  and  top 
margins  printed  as  needed.   The  headings  specified  in  the  program  are  then 
printed.   The  line  of  output  in  PRINTER  is  then  printed,  spacing  one  line. 
When  the  second  CALL  PRINTX  statement  is  encountered,  the  print  routine 
(assuming  the  page  size  is  larger  than  6)  will  space  down  six  lines,  and 
print  the  second  line.   The  output  will  then  appear  as: 

PAGE  HEADING 

ONE  LINE  OF  OUTPUT 

(5  blank  lines) 

MORE  OUTPUT 
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The  statement  "CALL  EXIT  (PARM);"  is  required  after  all  print  calls 
have  been  made.   This  entry  point:   1)  closes  the  printer  file,  and  2)  copies 
INSTR  into  PARM  to  return  values  to  the  HIS  supervisor. 

The  print  routine  has  two  additional  entry  points.   Entry  point  ASTER 
prints  a  line  containing  132  asterisks;  this  is  handy  to  set  off  error  messages 
that  are  otherwise  easily  unnoticed.   Entry  point  PRINTXA  can  be  used  to 
ensure  that  a  summary  can  fit  on  one  page.   For  example,  assume  that  an 
unknown  amount  of  output  has  already  been  printed,  and  a  thir teen-line  summary 
is  to  be  printed.   If  there  are  thirteen  lines  left  on  the  current  page,  the 
summary  is  to  be  printed  on  the  same  page  as  the  previous  output.   If  there 
are  less  than  thirteen  lines  left,  a  new  page  is  to  be  started.   The  state- 
ment "CALL  PRINTXA  (1,13)"  will  insure  that  a  new  page  is  started  if  there 
are  less  than  13  lines  remaining  on  the  current  page.   The  first  number  passed 
has  the  same  meaning  as  when  calling  PRINTX,  and  the  line  to  be  printed  is 
placed  in  PRINTER.   An  example  program  is: 

DECLARE  PARM  CHAR ( 100 ) ,  INSTR  CHAR(80)  EXT,  #_HDGS  PIC'Z'  DEF 
INSTR  POS(72) ,  (PRINTER, HEADING (9))  CHAR(132)  EXT, 
PRINTX  ENTRY  (PIC'Z'),  PRINTXA  ENTRY  (PIC 'Z' ,PIC 'ZZ ' )  ; 
CALL  INIT  (PARM) ; 

PRINTER  =  '    FIRST  LINE  OF  SUMMARY » ; 
CALL  PRINTXA  (1,13); 
PRINTER  =  '    NEXT  LINE'; 
CALL  PRINTX  (1) ; 

CALL  EXIT  (PARM) ; 

Following  is  the  program  listing  for  the  printer  subroutine: 
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/*  SUBROUTINE  HANDLING  LINE-PRINTING  FOR  HIS  ROUTINES  */ 

l:  /*  SUBROUTINE  HANDLING  LINE-PRINTING  FOR  HIS  ROUTINES  */ 
2:  PRINTX:   PROCEDURE  (F); 


3 

4 

5 

6 

7 

8 

9 

10 

11 

12 

13 

14 

15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 
26 


/*  CONTROL  VARIABLES  IN  HIS  INSTRUCTION  */ 

DECLARE 

INSTR  CHAR(80)  EXT, 

PAGESIZE  PIC'ZZ'  OFF  INSTR  P0S(7), 
PAGE_POSITION  PIC'ZZ'  DEF  INSTR  P0S(9), 
TOP.MARGIN  PIC'ZZ'  DEF  INSTR  POS(ll), 
PAGE_NUMBER  PIC'ZZZZ'  DEF  INSTR  P0S(15), 
TABLE_NUMBER  PIC'ZZ'  DEF  INSTR  P0S(21), 
EJECT_CODE  CHAR(l)  DEF  INSTR  POS<23), 
OODPOS  PIC'ZZZ'  DEF  INSTR  P0S(73), 
EVENPOS  PIC'ZZZ'  DEF  INSTR  P0S<76), 
#_HDGS  PIC'Z'  DEF  INSTR  P0SI72); 

/*  INTERNAL  VARIABLES  */ 
DECLARE 

#_LINES  PIC'ZZ', 

ASTS  CHAR(132)  STATIC  INIT  <(132)'*M, 

BLANKS  CHAR(132)  STATIC  INIT  <•  •), 

F  PIC'Z', 

FRMT(0:3)  CHAR(l)  STATIC  INIT  ('♦','  ','0','-'l 

FO  DEC  FIXED  (1,0)  STATIC, 

P  CHARU33)  STAT  IC  , 

PI  CHAR(l)  DEF  P, 

P2    CHAR(132)  DEF  P  P0S(2), 

PARM  CHAR( 100) ; 


27:  /*  EXTERNAL  VARIABLES  */ 
28:  DECLARE 

29:     HEADING(9)  CHAR(132)  EXT, 
30:     PRINTER  CHAR(132)  EXT; 


31:  START: 
32:     FO  =  F; 

33:  STARTl: 

34:     /*  NEW  PAGE  REQUIRED?  */ 

35:     IF  PAGE__P0SITI0N*F0>PAGESIZE  I  F0>8  THFN  DO 

36:       PI  =  •  1' ; 


i  i 


» 


37:  P2  = 

38:  PAGE_POSITION  =  0; 

39:  /*  PAGE  NUMBERING?  */ 

40:  IF  PAGE_NUMBER-^=0  THEN  DO; 

41 :  Jl  =  PAGE.NUMBER; 

42:  J2  =  Jl/2;   J2  =  J2*2; 

43:  IF  Jl=J2 

44:  THFN  SUBSTR ( P2 , EVENPOS, 4)  =  PAGE_NUMBER; 

45:  ELSE  SUBSTR( P2, ODDPOS, 4 )  =  PAGE_NUMBER; 

46:  WRITE  FILE  (PRNT)  FROM  (P); 

47:  PAGE_NUMBER  =  PAGE.NUMBER  ♦  1; 

48:  PI  =  •  •; 

49:  PAGE_POSITION  =  1; 

50:  END; 


-35- 


/*  SUBROUTINE  HANDLING  LINE-PRINTING  FOR  HIS  ROUTINES  */ 


51:  /*  TABLE  NUMBERING?  */ 

52:  IF  TABLE_NUMBER-i=0  THEN  DO; 

53:  P2  =  SUBSTR(BLANKS,1,54>  II  'TABLE  NUMBER  • 

54:  WRITE  FILE  (PRNT)  FROM  (P); 

55:  PI    =    •O1 ; 

56:  PAGE_POSITION    =    PAGE.POSI TION    +    2; 

57:  END; 

58:  /*    TOP    MARGIN?    */ 

59:  Jl    =    TOP_MARGIN; 

60:  P2  =  '  « ; 

61:  DO  WHILE  ( Ji>0) ; 

62:  IF  Pl=»l«  THEN  WRITE  FILE  (PRNT)  FROM  (P); 

63:  IF  Jl>3  THEN  DO; 

64:  pi  =  •-•; 

65:  write  file  (prnt)  from  (p); 

66:  Jl  =  Jl  -  3; 

67:  END; 

68:  ELSE  DO; 

69:  PI  =  FRMT(Jl); 

70:  Jl  =  0; 

71:  END; 

72:  END; 

73:  PAGE_POSITION  =  PAGE.POS  IT  ION  ♦  TOP.MARGIN; 

74:  /*  PAGE  HEADINGS?  */ 

75:  IF  #_HDGS-=0  THEN  DO  J 1= 1  TO  #_HDGS; 

76:  P2  =  HEADING! Jl ); 

77:  WRITE  FILE  (PRNT)  FROM  (P); 

78:  PI  =  '  «; 

79:  END; 

80:  PAGE_POSITION  =  PAGE_POS IT  ION  ♦  #_HDGS; 

81:  IF  F0>8  THEN  FO  =  l; 

82:  EJECT.CODE  =  •  •; 

83:  IF  Pl=« 1'  THEN  DO; 

84:  P2  =  '  '  ; 

85:  WRITE  FILE  (PRNT)  FROM  (P); 

86:  END; 

87:  END; 

88:  PAGE.POSITION  =  PAGE_POS I T ION  ♦  FO; 

89:  /*  CHECK  FOR  P AGE_E JECT=SUPPRE SS  */ 

90:  IF  EJECT_CODE=,S'  THEN  DO; 

91:  IF  PAGE_P0SITI0N+#_HDGS+10>PAGESIZE  THEN  DO; 

92:  PAGE.POSITION  =  PAGESIZE; 

93:  GOTO  START; 

94:  ENO; 

95:  P  =  •-• ; 

96:  DO  J  1=1  TO  2; 

97:  WRITE  FILE  (PRNT)  FROM  (P); 

98:  END; 

99:  IF  #_HDGS-.  =  0  THEN  DO  Jl  =  l  TO  #_HDGS; 

100:  P  =  •  ■  II  HEADINGl J  1)  ; 

101:  WRITE  FILE  (PRNT)  FROM  (P); 

102:  END; 

103:  PAGE.POSITION  =  PAGE_POS IT  ION  *    #_HDGS  ♦  6; 

104:  EJECT_CODE  =  •  • ; 


II  table.number; 
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/*  SUBROUTINE  HANDLING  LINE-PRINTING  FOR  HIS  ROUTINES  */ 

105:        END; 

106:  DO  WHILE  <F0>3> ; 

107:        P  =  •-• ; 

108:        WRITE  FILE  (PRNT)  FROM  (P); 

109:        FO  =  FO  -  3; 

110:        END; 

111:  P  =  FRMT(FO)  I  I  PRINTER; 

112:  WRITE  FILE  (PRNT)  FROM  (P); 

113:  RETURN; 


114:  /*  ENTRY  PRINTXA  FOR  TESTING  NUMBER  OF  LINES  LEFT  ON  PAGE  */ 

115:  PRINTXA:   ENTRY  (F,#_LINES); 

116:     IF  PAGE_POSITION+#_LINES>PAGESIZE  THEN  DO; 

117:        PAGE_POSITION  =  PAGESIZE; 

118:        FO  =  l; 

119:        END; 

120:     ELSE  FO  =  F; 

121:     GOTO  STARTl; 


122:  /*  ENTRY  INIT  FOR  HIS  INITIALIZATION  */ 

123:  INIT:   ENTRY  (PARM); 

124:     OPEN  FILE  (PRNT)  OUTPUT  RECORD  TITLE  (»PRINTERM; 

125:     INSTR  =  PARM; 

126:     HEADING  =  •  •  ; 

127:     #_HDGS  =  0; 

128:     RETURN; 


129:  /*  ENTRY  POINT  EXIT  CLOSES  PRINT  FILE  */ 

130:  EXIT:   ENTRY  (PARM) ; 

131:     CLOSE  FILE  (PRNT); 

132:     IF  TABLE_NUMBER-.=0  THEN  TABLE.NUMBER  =  TABLE_NUMBER  +  1; 

133:     PARM  =  INSTR; 

134:     RETURN; 


135:  /*  ENTRY  POINT  ASTER  PRINTS  LINE  OF  ASTERISKS  */ 

136:  ASTER:   ENTRY; 

137:     P  =  •  •  M  ASTS; 

138:     WRITE  FILE  (PRNT)  FROM  (P); 

139:     RETURN; 

140:  END  PRINTX; 
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HIS1  Cataloged  Procedure 

-» 

HIS1  is  a  procedure  cataloged  for  utilizing  programs  operating  under 
HIS.   It  contains  DD  statements  STEPLIB,  SYSPRINT,  PRINTER,  INSTRCT,  and  PROGTBL:  m 

r 

//  PROC  XLIB=fHIS.LOADTST'  U 

//HIS  EXEC  PGM=SUPER 

//STEPLIB  DD  DISP=SHR,DSNAME=&XLIB 

//        DD  DISP=SHR,DSNAME=HIS.LOADLIB 

//PRINTER  DD  SYSOUT=A,DCB=(BLKSIZE=1300,LRECL=133,RECFM=FBA) 

//SYSPRINT  DD  SYSOUT=A 

//INSTRCT  DD  UNIT=SYSDA,SPACE=(TRK, (1,1) ) 

//PROGTBL  DD  DISP=SHR,DSNAME=HIS .TABLES (PGMTBL) 

The  symbolic  parameter  XLIB  may  be  used  to  respecify  the  data  set  name 
of  a  library  containing  executable  load  modules  to  be  specified  on  commands. 

The  procedure  contains  all  DD  statements,  other  than  SYS IN  (user 
commands),  used  by  the  supervisor,  command  decoder,  and  printer  subroutine. 
All  other  DD  statements  utilized  by  programs  executed  in  a  run  must  be 
supplied  with  the  run. 

Writing  Programs  Under  HIS 

Programs  that  do  not  require  an  instruction  —  If  a  program  is  to  be 
written  that  does  not  require  an  instruction  passed  to  it  (i.e.,  the  formatting 
options  will  not  be  used,  and  options  from  the  command  do  not  need  to  be 
processed) ,  the  program  is  simply  written  (in  any  language) ,  and  cataloged 
into  a  library  with  a  name  of  four  or  less  characters.   To  execute  the  program, 
simply  supply  a  command  having  a  colon  in  column  1,  and  the  program  name 
in  columns  2-5.   In  the  following  simple  PL/I  program  that  reads  cards  and 
prints  them,  the  DD  statement  INPUT  is  used  to  read  cards: 

PGM:   PROC  OPTIONS  (MAIN); 

DECLARE  A  CHAR(80) ; 

ON  ENDFILE  (INPUT)  GOTO  STOP; 
LOOP:  GET  FILE  (INPUT)  EDIT  (A)  (A(80)); 

PUT  FILE  (SYSPRINT)  SKIP  EDIT  (A)  (A) ; 

GOTO  LOOP; 
STOP:  CLOSE  FILE  (INPUT); 

END  PGM; 
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The  program  is  stored  in  the  cataloged  library  HIS.LOADTST,  under  the  name 
PRNT.   The  program  is  then  executed  by: 

//  EXEC  HIS1 

//SYS IN  DD  * 

:PRNT 

/* 

//INPUT  DD  * 

cards  to  be  printed 

/* 

Programs  that  require  an  instruction  —  If  the  program  is  going  to  accept 
the  instruction  passed  by  the  supervisor,  it  must  be  written  in  either  BAL  or 
PL/I.   If  the  program  is  in  BAL,  the  instruction  is  retrieved  by  following 
the  pointer  in  register  1  (see  Figure  2-1-2) .   To  retrieve  the  instruction  in 
a  PL/I  program,  a  100-character  variable  is  coded  on  the  PROC  statement. 
Individual  characters  are  then  retrieved  by  overlay  defining  or  by  using 
SUBSTR.   The  preceding  PL/I  example  program  is  to  be  modified  such  that  the 
name  of  the  input  DD  statement  is  to  be  specified  on  the  instruction.   When 
executing  the  modified  program,  the  parameter  DDNAME=ddname  is  specified  on 
the  command;  the  command  decoder  places  the  name  in  columns  24-31  of  the 
instruction.   A  modified  program  listing  is: 

PGM:    PROC  (PARM)  OPTIONS  (MAIN) ; 
DECLARE 

A  CHAR(80), 
PARM  CHAR (100) , 

DDNAME  CHAR(8)  DEF  PARM  P0S(24); 
ON  ENDFILE  (INPUT)  GOTO  STOP; 
OPEN  FILE  (INPUT)  TITLE  (DDNAME) ; 
LOOP:   GET  FILE  (INPUT)  EDIT  (A)  (A(80)); 

PUT  FILE  (SYSPRINT)  SKIP  EDIT  (A)  (A) ; 
GOTO  LOOP; 
STOP:   CLOSE  FILE  (INPUT); 
END  PGM; 

The  program  may  then  be  executed  by: 
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//  EXEC  HIS1 
//SYS IN  DD  * 
: PRNT ,DDNAME=OPERA 

/* 

//OPERA  DD  * 


cards  for  printing 


/* 


PL/I  routines  whose  output  is  to  be  based  on  the  HIS  formatting  options  may 
utilize  the  printer  subroutine.   Assume  that  the  above  program  is  to  be 
modified  to  use  this  subroutine.   Assume  also  that  the  first  card  read  is  to 
be  used  as  a  heading  printed  on  each  page  of  the  output.   A  blank  line  is  to 
be  placed  between  the  heading  and  the  first  line  of  output  on  each  page.   A 
new  listing  that  will  accomplish  this  is: 


PGM: 


LOOP: 


STOP: 


PROC  (PARM)  OPTIONS  (MAIN) ; 

DECLARE 

PARM  CHAR(IOO) , 

DDNAME  CHAR(8)  DEF  PARM  POS(24), 

INSTR  CHAR(80)  EXTERNAL, 

#_HDGS  PIC'Z'  DEF  INSTR  POS(72), 

PRINTER  CHAR (132)  EXTERNAL, 

HEADING(9)  CHAR (13 2)  EXTERNAL, 

PRINTX  ENTRY  (PIC'Z'), 

A  CHAR(80) ; 

ON  ENDFILE  (INPUT)  GOTO  STOP; 

OPEN  FILE  (INPUT)  TITLE  (DDNAME) ; 

CALL  INIT  (PARM) ; 

#_HDGS  =  2; 

GET  FILE  (INPUT)  EDIT  (A)  (A(80)); 

HEADING(l)  =  A; 

GET  FILE  (INPUT)  EDIT  (A)  (A(80)); 

PRINTER  =A; 

CALL  PRINTX  (1) ; 

GOTO  LOOP; 

CLOSE  FILE  (INPUT) ; 

CALL  EXIT  (PARM) ; 

END  PGM; 


The  program  may  then  use  formatting  options  and  be  executed  by: 

//  EXEC  HIS1 

//SYSIN  DD  * 

: PRNT , DDNAME=OUCH , PAGE=NUMBER=1 

/* 

//OUCH  DD  * 

heading  card 

cards  for  printing 
/* 
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HIS. TABLES 

HIS. TABLES  is  a  cataloged  library  containing  several  tables  used  by  HIS 
routines.   These  tables  can  be  used  to  obtain  county  names  from  county  numbers 
and  other  similar  functions.   Each  table  is  stored  in  80-byte  records,  and 
may  be  updated  with  IBM  utility  program  IEBUPDTE. 

PGMTBL  —  PGMTBL  is  a  table  of  program  names  processed  by  the  command 
decoder.   Rather  than  specifying  the  actual  load  module  name  (1-4  characters) 
of  a  program,  a  program  name  (1-20  characters)  may  be  assigned,  and  an  entry 
placed  in  the  program  table.   The  decoder  compares  the  program  name  specified 
on  a  command  with  the  entries  in  the  table,  and,  if  a  match  is  found,  substi- 
tutes the  load  module  name.   If  no  match  is  found,  the  decoder  uses  the  name 
specified  on  the  command  as  the  load  module  name  (using  the  first  four 
characters  if  the  name  is  longer  than  4  characters) .   Each  record  in  the 
table  specifies  a  program  name  in  columns  1-20,  and  the  load  module  name  in 
columns  21-24.   Columns  25-72  may  contain  any  descriptive  information  desired; 
these  are  not  processed.   Columns  73-80  contain  sequence  numbers  for  updating 
the  file.   Programs  may  have  alias  names  if  desired;  simply  place  additional 
records  in  the  table,  each  specifying  the  same  load  module  name. 

CITYTBL  —  CITYTBL  provides  the  names  of  the  incorporated  cities  of 
Montana,  along  with  their  population  and  county  location.   The  table  consists 
of  a  record  for  each  city,  located  in  the  table  by  city  number.   Hence,  the 
35th  record  in  the  file  corresponds  to  city  number  35,  Drummond.   Each  record 
contains  the  following  information: 

Columns  1-18:  City  name,  left  justified. 

Columns  19-36:  City  name,  centered. 

Columns  37-54:  City  name,  left  justified,  with  blanks  replaced 

with  hyphens . 

Column  55:  Population  group. 

Column  56:  Blank.  l 

Columns  57-58:  County  number,  alphabetical  numbering. 

Column  59:  Blank. 

Columns  60-61:  County  number,  license  numbering. 

Columns  62-72:  Blank. 

Columns  73-80:  Sequence  number. 
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CNTYTBL  —  CNTYTBL  provides  the  name  and  financial  district  of  each  of 
the  counties.   The  56  records  are  placed  in  order  by  the  alphabetical  number- 
ing system,  placing  Beaverhead  as  the  first  county.   Each  record  contains: 


Columns  1-15 : 
Columns  16-30 
Columns  31-45 
Columns  46-49 
Columns  50-51 
Columns  52-72 
Columns  73-80 


County  name,  left  justified. 

County  name,  centered. 

County  name,  right  justified, 

Blank. 

Financial  District  (1-12). 

Blank. 

Sequence  number. 


PROJTBL  —  PROJTBL  is  a  table  of  the  project  types  used  in  the  Roadlog 
The  records  are  placed  in  order  by  classification  number.   Hence,  class  FU 
(classification  number  5)  is  the  5th  record.   The  records  contain: 


Columns  1-5:  Project  class,  left  justified. 

Columns  6-10:  Project  class,  centered. 

Columns  11-15:  Project  class,  right  justified. 

Columns  16-72:  Blank. 

Columns  73-80:  Sequence  number. 


Project  classes  are  often  added  to  the  system;  hence,  the  table  will  contain 
an  unknown  number  of  records.   Programs  utilizing  the  table  should  be  written 
to  accept  whatever  number  of  classifications  are  available  in  the  file. 
Because  the  records  are  stored  by  classification  number,  care  must  be  taken 
when  updating.   New  classifications  should  be  placed  after  the  last  one  in 
the  file.   When  a  classification  is  deleted,  the  record  cannot  be  deleted  from 
the  file  unless  a  dummy  record  (or  a  new  classification)  is  stored  in  its 
place. 

SURFTBL  —  SURFTBL  provides  a  method  of  converting  from  the  4-digit 
Roadlog  surface  type  code  to  a  1-digit  (1-8)  conversion.   Each  surface  type 
is  coded  on  a  separate  record: 


Columns  1-4 : 
Columns  5-8: 
Columns  9-10: 
Columns  11-13 : 
Columns  14-16 : 


4-digit  surface  type  code. 

1-digit  code,  right  justified. 

Blank. 

3-character  code  indicating  type  group, 

Blank. 
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Columns  17-26 
Columns  27-36 
Columns  37-72 
Columns  73-80 


10-character  heading. 

10-character  heading. 

Blank. 

Sequence  number. 


SMSFTBL  —  SMSFTBL  provides  a  second  table  of  surface  types,  used  in 
producing  state  mileage  tables.   The  records  are  of  the  same  format  as  in 
SURFTBL,  but  provide  a  different  breakdown  of  surface  types  and  a  different 
set  of  headings  for  printing  reports.   The  Roadlog  program  SURF-TYPE  reads 
this  table  instead  of  SURFTBL  if  REPORT=SMTABLES  is  specified  in  place  of 
REPORT=ROADLOG. 

SUFFTBL  —  SUFFTBL  contains  a  number  of  tables  used  in  producing  the 
Suff iciency-by-Sections  report.   The  table  is  described  in  Chapters  1-V  and 
2-V. 
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CHAPTER  2-II 
ROADLOG  PROGRAMMER  INFORMATION 

Introduction 

This  chapter  presents  a  description  of  the  programs  comprising  the 
Roadlog  subsystem  of  HIS  (Highway  Information  System) .   It  is  designed  for 
utilization  with  the  publication  Highway  Information  System  Volume  1;   User 
Information. 

Roadlog  File  Description 

Data  Set  Name HIS. ROADLOG 

Organization   Indexed  Sequential 

Logical  Record  Length  120 

Physical  Record  Length   1560 

Key  Length 13 

Volume  Serial  Number   231428 

The  internal  format  of  a  Roadlog  record  is  shown  in  PL/ I  terminology  in 
Figure  2-II-1.   Most  of  the  numeric  fields  are  stored  in  packed  decimal  format 
to  conserve  storage  and  to  improve  efficiency. 

The  two  location  code  fields  are  stored  numerically  rather  than  in  the 
4-byte  character  string  coded  on  the  Roadlog  data  cards.   Table  2-II-I  shows 
the  relationship  between  these  character  strings  and  the  stored  values. 

The  project  classification  field  and  the  surface  type  field  have  been 
added  to  the  record  to  increase  the  efficiency  of  several  summary  and  report 
programs.   Tables  2-II-II  and  2-II-III  list  the  project  classification  and 
surface  type  codes. 

Subroutines 

Several  of  the  Roadlog  programs  utilize  the  subroutines  SRTYPR  and 
RLGCON.   The  subroutines  are  stored,  in  object  module  format,  in  cataloged 
library  HIS. OBJECT. 


-44- 


ROADLOG_RECORD , 

2  DELETE_CHARACTER 

2  KEY, 

3   ROUTE_SYSTEM 

3   ROUTE_NUMBER 

3   REFERENCE_POST 

3  DISTANCE  " 
2  REMARK 
2   SECTION_LENGTH 
2  ROUTE__LENGTH 
2  CONSTRUCTED_LENGTH 
2  UNIMPROVED_LENGTH 
2  WYE_LENGTH 
2  DESCRIPTION 
2  PROJECT_NUMBER 
2  DIVIDED_UNDIVIDED_CODE 
2  NUMBER_OF_LANES 
2   POPULATION_CODE 
2   CITY_NUMBER 
2  COUNTY_NUMBER 
2  YEAR_BUILT 
2  YEAR_IMPROVED 
2  FOREST_HIGHWAY_NUMBER 
2  ADMINISTRATION_CODE 
2  L0CATI0N_C0DES(2) 
2  PROJECT_CLASSIFICATION 
2   SURFACE_WIDTH 
2  ROADWAY_WIDTH 
2   SURFACE_THICKNESS 
2   BASEJTHICKNESS 
2   SURFACE_TYPE_CODE 
2   SURFACE_TYPE 
2  MAINTENANCE_SECTION 
2  DATE, 

3  MONTH 

3   DAY 

3  YEAR 
2  DUMMY 


CHAR(l)  , 

CHAR(l)  , 
CHAR(3) , 
CHAR(3), 
CHAR (6) , 
CHAR(2) , 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
CHAR(35), 
CHAR (11) , 
CHAR(l) , 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 

DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
CHAR(2); 


(5,3), 
(5,3), 
(5,3), 
(5,3), 
(3,3), 


1,0 
1,0 
3,0 
2,0 
2,0 
2,0 
2,0 
2,0 
2,0 
2,0 
2,0 
2,0 
3,1 
3,1 
1,0 
4,0 
4,0 

2,0 
2,0 
2,0 


Figure  2-II-1.   ^oadlog  file  structure. 
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TABLE  2-II-I 
LOCATION  CODES 


Character 

Numeric 

blank 

0 

CITY 

1 

CNTY 

2 

NFOR 

3 

IRES 

4 

GAME 

5 

MRES 

6 

NMON 

7 

NPRK 

8 

SFOR 

9 

SPRK 

10 
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TABLE  2-II-II 
PROJECT  CLASSIFICATIONS 


1 

F 

18 

ERS 

35 

CCC 

52 

WPMH 

2 

FI 

19 

CC 

36 

DARM 

53 

WPMS 

3 

FG 

20 

MC 

37 

ECHP 

54 

WPSO 

4 

FGI 

21 

NFD 

38 

EFAP 

55 

WPSS 

5 

FU 

22 

IN 

39 

EFHP 

56 

WPGH 

6 

S 

23 

USG 

40 

FAP 

57 

WPGM 

7 

SG 

24 

US 

41 

FAS 

58 

WPGS 

8 

U 

25 

I 

42 

FAGH 

59 

SC 

9 

UI 

26 

ING 

43 

FAGM 

60 

SAP 

10 

UG 

27 

DF 

44 

FAGS 

61 

WER 

11 

UGI 

28 

DFG 

45 

FLP 

62 

AE 

12 

FL 

29 

DS 

46 

NRFL 

63 

UR 

13 

FLI 

30 

DSG 

47 

NRH 

64 

UF 

14 

FLG 

31 

DU 

48 

NRM 

65 

WPH 

15 

FLGI 

32 

R-AD 

49 

NRS 

66 

A-AD 

16 

FHP 

33 

IG 

50 

NP 

17 

ERF 

34 

ERFO 

51 

WHP 
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TABLE  2-II-III 
SURFACE  TYPE  CODES 


Surface  Type  Value 

Primitive  *■ 

Un improved  2 

Graded  and  Drained  3 

Gravel  4 

Bituminous  Surface  Treatment  5 

Road  Mix  6 

Plant  Mix  7 

Portland  Cement  Concrete  8 
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SRTYPR  — 


Object  Module  Name  SRTYPR 

Language PL/I 

Files SYSPRINT  —  IBM  messages 

SURFTBL  —  Surface  Type  Table 

Entry  Points  SRTYPRI 

SRTYPRA 


SRTYPR  is  a  subroutine  which  converts  the  4-digit  Roadlog  surface  type  designa- 
tion into  a  simpler  1-digit  designation.   The  new  designation  is  a  number 
between  1  and  8  shown  in  Table  2-II-III.   A  value  of  zero  is  returned  when  an 
undefined  Roadlog  surface  type  is  given.   The  subroutine  utilizes  a  table 
defining  the  valid  Roadlog  surface  type  codes.   The  table  is  read  via  DD  state- 
ment SURFTBL  one  time  only,  and  stored  in  core  for  future  use.   Each  record  in 
the  table  defines  one  surface  type,  together  with  the  new  1-digit  designation 
to  be  returned.   The  table  read  will  normally  be  member  SURFTBL  in  cataloged 
library  HIS. TABLES.   To  utilize  SRTYPR,  the  calling  program  must  first  invoke 
the  subroutine  at  entry  point  SRTYPRI.   Here,  SRTYPR  reads  the  surface  type 
table  and  stores  the  values  in  static  array  (binary  format)  SURTYP.   This  array 
allows  for  a  maximum  of  50  records  in  the  table  (variable  #_SURF_TYPES  notes 
the  actual  number  of  records  read).   After  invoking  SRTYPRI,  the  calling  pro- 
gram may  perform  conversions  by  invoking  SRTYPRA,  passing  a  binary  (length  15) 
surface  type  designation.   The  subroutine  compares  the  value  to  the  designations 
read  from  the  table,  substituting  the  new  designation  for  the  value  passed. 
If  no  match  is  found,  a  value  of  zero  is  returned.   Note  that  the  new  designa- 
tion is  returned  in  the  same  parameter  in  which  the  old  designation  is  passed, 
destroying  the  passed  value.   An  example  of  SRTYPR  usage  is: 

PROG :   PROCEDURE  OPTIONS  (MAIN) ; 

DECLARE 

I  BINARY  FIXED  (15) , 
SURF_TYPE  DEC  FIXED  (4,0); 

CALL  SRTYPRI; 
LOOP:   GET  FILE  (SURFTYP)  EDIT  (SURF_TYPE)  (F(4,0)); 

I  =  SURF_TYPE; 

CALL  SRTYPRA  (I) ; 

PUT  FILE  (SYSPRINT)  SKIP  EDIT  (I)  (A) ; 

IF  1=0  THEN  GOTO  STOP; 

GOTO  LOOP; 
STOP:   END  PROG; 

Following  is  the  SRTYPR  program  listing: 
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l:  SRTYPRI:   PROCEDURE; 

2:  /***  SUBROUTINE  TO  RETURN  SURFACE  TYPE  CLASS  *****/  |~ 

3:  /*****  DECLARATION  OF  VARIABLFS  (ALPHABETICAL  ORDER)  *****/ 

4:  DECLARE 

5:     #_SURF_TYPES  BIN  FIXED  STATIC, 

6:     INSTR  CHAR(80)  EXT,  [" 

7:     REPORT  CHAR(l)  DEF  INSTR  POS(8),  L 

8:     1   STYP, 

9:  J    (S1,S2)     P I C  •  Z  Z  Z  Z  •  , 

10:  3       DUMMY    CHAR<72), 

11:  SUPTYP<50,2)     BIN    FIXED    STATIC, 

12:  TABLE    FILE    INT    RECORD; 


14 
15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 
26 
27 
28 
29 
30 


32 
33 

34 
35 
36 
37 
38 
39 
40 
41 
42 


13:     /*****    PROGRAM     INITIALIZATION    SECTION    *****/ 


INIT: 

IF  REPORT-.=  ,Q« 

THEN  OPEN  FILE  (TABLE)  INPUT  RECORD  TITLE  ('SURFTBLM; 
ELSE  OPEN  FILE  (TABLE)  INPUT  RECORD  TITLE  ('SMSFTBLM; 

ON  ENDFILE  (TABLE)  GOTO  CONTINUE;  * 

#_SURF_TYPFS  =  0; 

SURTYP  =  o; 
READ_TEMP:  . 

READ  FILE  (TABLE)  INTO  (STYP); 

#_SURF_TYPES  =  #_SURF_TYPES  ♦  1; 

IF  #_SURF_TYPES>50  THEN  GOTO  CONTINUE; 

SURTYP(#_SURF_TYPES,1)  =  STYP. SI; 

SURTYP(#_SURF_TYPES,2)  =  STYP.S2; 

GOTO  REAO_TEMP; 
CONTINUE:  ■ 

CLOSE  FILE  (TABLE); 

RETURN; 


31S  /*****  ENTRY  POINT  FUR  DETERMINING  ROADLOG  SURFACE  TYPE  CATEGORY  ****^ 


SRTYPRA: 

ENTRY  (Jl); 

DO  J2=l  TO  #_SURF_TYPES; 

IF  J1=SURTYP( J2,l)  THEN  GO  TO  S AT  I SF I ED_SURF ACE_TYPE ; 
END; 

Jl  =  0;    /**  NO  MATCH  **/ 

RETURN;  * 

SATISFIED_SURFACE_TYPE: 

Jl  =  SURTYP(J2,2)  ; 

IF  Jl=9  THEN  Jl  =  7;  • 

RETURN; 


43:  END  SRTYPRI; 
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RLGCON  — 


Object  Module  Name  RLGCON 

Language PL/ 1 

Subroutines   SRTYPR 

Files SYSPRINT  —  IBM  messages 

PROJTBL  —  Project  Class  Table 
SURFTBL  —  Surface  Type  Table 

Entry  Points  RLGCON 

CO  VI 
C0V2 


RLGCON  converts  Roadlog  data  cards  into  the  Roadlog  file  format,  and  vice 
versa.   When  conversions  from  the  Roadlog  2-card  sequence  to  the  Roadlog  file 
format  must  be  performed,  the  subroutine  must  first  be  invoked  at  initializa- 
tion entry  point  RLGCON.   At  this  entry  point,  the  project  class  table  (DD 
name  PROJTBL)  is  read,  and  SRTYPR  is  invoked  at  its  initialization  entry  point, 
SRTYPRI.   The  subroutine  is  then  invoked  at  entry  C0V1  as  many  times  as  required, 
passing  two  80-character  data  cards,  and  a  120-character  variable  for  the 
returned  Roadlog  record.   An  example  of  such  usage  is: 

PGM:    PROCEDURE  OPTIONS  (MAIN) ; 

DECLARE 

(CARD1,CARD2)  CHAR(80) , 
RECORD  CHAR  (120) ; 

CALL  RLGCON; 
LOOP:   GET  FILE  (SYSIN)  EDIT  (CARD1,CARD2)  (A(80)); 

CALL  C0V1  (CARD1, CARD 2 , RECORD) ; 

WRITE  FILE  (OUTPUT)  FROM  (RECORD) ; 

GOTO  LOOP; 

END  PGM; 

When  converting  from  Roadlog  record  format  to  card  format,  it  is  not  necessary 
to  first  read  the  project  and  surface  type  tables.   RLGCON  is  simply  invoked 
at  entry  point  C0V2,  passing  two  80-character  variables  for  the  returned  cards, 
and  a  120-character  Roadlog  record  (e.g.,  CALL  C0V2  (CARD1, CARD2, RECORD) ;  in 
the  above  program) . 

The  RLGCON  program  listing  follows: 
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RLGCCN:  PROCEDURE; 


r 

- 


1 

2 
3 

5 
6 
7 
8 
9 
10 
11 
12 
13 
14 
15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
3  5 
36 
37 
38 
39 
40 
41 
42 
43 
44 
45 
46 
47 
48 
49 
50 
51 
52 
53 
54 
55 
56 
57 
58 


[ 


: 


RLGCCN:     PROCEDURE; 
DECLARE 
1    C01     RASED(PTR_CD1), 

?    DUM1    CHAR(l),  r 

?    KEY    CHARC 13),  L 

2    DESCR    CHAR( 35) , 

2    MAINT_SECTN    PIC'ZZZZ', 

2    PROJ_#    CHAR( 11) , 

?    REMARK    CHAR(  2)  ,  *~ 

?     (CNTY_#,FORHWY_tf , ADMIN) 

?    L0CN(2)     CHAR(4), 
1    CD2    BASED(PTR_CD2) , 

1  DUM1    CHARC 1), 

2  KEY    CHAR(  13)  ,  r- 
2    #_LANES    PIC»Z* , 

2    DIVIDED    CHAR< 1),  b 

2    POPULATION    PIC'Z*  , 

2    CITY_#    PIC'ZZZ' , 

2    YR.BLT    PIC'ZZ',  L 

2    SURF_TYPE    PIC^ZZZZ' , 

2    SURF_THICK    PIC'ZVZ1  ,  r 

2  BASE_THICK  PIC»ZZVZ«,  L 

2  (SURF_WIDTH,R0A0_WIDTH>  PIC^Z', 

2  (ROUTE, CNST,UNIMP)  PIC'ZZVZZZ', 

2  WYE  PIC^ZZZ'  , 

2  SECTN  PIC'ZZVZZZ*  ,  ■ 

2  YR_IMP  PIC'ZZ* , 

2  DATE, 

3  (MONTH, DAY, YEAR)  PIC^Z1,  L 

1  RLG  BASED(PTR_NEW) , 

2  DUMMY1  CHAR(l),  r 

2  KEY  CHAR(  13) , 

2  REMARK  CHAR(2),  * 

2  (SECTN, ROUTE, CONST, UNIMP)DEC  FIXED(5,3), 

2  WYE  DEC  FIXED( 3, 3) , 
2  DESCR  CHAR(35),  I 

2  PROJ_#  CHAR( 11 ), 

2  DIVIDED  CHAR( 1) ,  I 

2  <#_LANES,POPULATION)DEC  FIXED(1,0),  L 

2  ( C IT Y_# ,CNTY_# , YR_BLT , YR_I MP , FORHWY_# , ADM  I N , 
LOCATION (2) ,PROJ_CLASS,SURF_WlDTH,ROAD_WIDTH) 
DEC  FIXED(3,0), 

2  (SURF_THICK,BASE_THICK)DEC  F1XED(3,1),  k 

2  SURF_TYPE_COOE  DEC  FIXED(1,0), 

2  ( SURF_TYPE,MAINT_SFC)DEC  FIXED(5,0), 

2  DATE,  L 

3  (MONTH, DAY, YEAR)DEC  FIXFD(3,0), 
PROJTBL  FILE  RECORD,  i 

PR0J_TYPE(75)  CHARJ4)  STATIC, 
#_PROJ  BIN  FIXED, 
PRJ  CHAR(4)  BASED(PTR>, 
(CARDl,CARD2)  CHAR(80), 

RECORD  CHAR( 120),  ' 

D3  DEC  FIXED( 3,0), 
(A1,D4)  CHAR(4); 
/♦♦INITIALIZATION**/  ' 

OPEN  FILE  (PROJTBL); 
ON  ENDFILE  (PROJTBL)  GOTO  ENO_PROJ; 
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RLGCCN:  PROCEDURE; 


59 

60 

61 

62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

12 

73 

74 

75 

76 

77 

78 

79 

80 

81 

82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 

100 

101 

102 

103 

1^4 

1C5 

106 

107 

108 

109 

110 

in 

112 
113 
114 
115 
116 


DO  #_PPOJ  = 
READ  FILE 
PROJ_TYPE 
END; 
END_PROJ: 

#_PR0J=#_ 
CLOSE  FIL 
CALL  SRTYPRI 
RETURN; 

COVl:     ENTRY(CAR01 
PTR_CD1=ADDR 
PTR_CD2=ADDR 
PTR_NEW=ADDR 
PECORD=' 
RLG=CD1,BY    N 
RLG=CD2,BY    N 
DO    1=     1    TO    2 
D4=CD1.L0CN< 
IF    04='     •     TH 
ELSE     IF    D4= 
ELSE     IF    04= 
ELSE    IF    D4= 
ELSE     IF    D4= 
ELSF     IF    D4= 
ELSE     IF    D4= 
ELSE     IF    D4= 
ELSE     IF    D4= 
ELSE    IF    D4= 
ELSE     IF    04= 
ELSE    D3=ll; 
RLG. LOCATION 
END; 

I=RLG.SUPF_T 
CALL  SRTYPRA 
RLG.SURF_TYP 
A1=PLG.PR0J_ 
IF  SUBSTR(Al 
IF  SUBSTR(A1 
DO  1=1  TO  #_ 
IF  A1=PRU 
END; 

RLG.PROJ_CLA 
GO  TO  VAR4; 

VAR3:  PLG.PROJ_CL 

VAR4:  RETURN; 

C0V2:     ENTRYtCAPDl 
PTR_CD1=ADDR 
PTR_CD2=ADDR 
PTR_NEW=ADDR( 
CARD1='     •; 
CARD2='     •; 
CD2=RLG,BY    N 
CD2.DUM1='  2' 
CD1=RLG,     BY 
CDi.DUMl='  !• 
DO    1=1    TO    2; 
D3=RLG.L0CAT 
IF    D3=0    THEN 


1  TO  75; 
(PROJTBL)  SET(PTR); 
(#_PROJ)=  PRJ; 


PROJ-1; 

E (PROJTBL)  ; 


,CARD2tREC0RD)  ; 

(CARD1) ; 

(CARD2); 

(RECORO) ; 
i  • 

ame; 
ame; 

I ); 

EN  D3=0; 

CITY'  THEN  D3=l; 

CNTY'  THEN  D3=2; 

NFOR'  THEN  03=3; 

IRES'  THEN  D3=4; 

GAME*  THEN  D3=5; 

MRES'  THEN  D3=6; 

NMON'  THEN  D3=7; 

NPRK'  THEN  03=8; 

SFOR'  THEN  D3=9; 

SPRK'  THEN  03=10; 


(  I)=D3; 

ype; 
(I) ; 

E_C0DE=I; 

#; 

,2, 11='  • 

,3,n  =  »  • 
proj; 

J_TYPE( I ) 

ss=o; 
ass=I; 


THEN 
THEN 


SUBSTR(A1,3)='  •; 
SUBSTR(A1,4)='  •; 


THEN  GOTO  VAR3; 


,CARD2, RECORD); 
(CARD1); 
(CARD2); 
RECORD) ; 


AME; 


NAME; 


ION(l) ; 
04='  '; 
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RLGCON:     PROCEDURE; 

117 

!                             ELSE 

IF 

03=1    THEN 

04= 

•CITY' ! 

118 

:                            ELSE 

IF 

03=2    THEN 

04=' 

'CNTY' i 

119 

:                           ELSE 

IF 

03=3    THEN 

04= 

'NFOR* ; 

120 

:                            ELSE 

IF 

D3=4    THEN 

04=' 

1  IRES'  i 

121 

!                            ELSE 

IF 

03=5    THEN 

D4=« 

'GAME' ! 

122- 

:                            ELSE 

IF 

03=6    THEN 

D4=« 

'MRES1 1 

123 

:                           ELSE 

IF 

03=7    THEN 

04= 

1 NMON' 

124. 

:                           ELSE 

IF 

D3=8    THEN 

D4= 

'NPRK' J 

125 

:                           ELSE 

IF 

D3=9    THEN 

04= 

1  SFOR' | 

126' 

:                            ELSE 

IF 

D3=10    THEN    04^ 

=  • SPRK' ; 

127 

:                           ELSE 

D4- 

=»ERR     •; 

128 

:                             CD1.L0CNCI )=04; 

129 

:                         END; 

130: 

RETURN; 

1311 

:                             END    RLGCON; 
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Program  Descriptions 

Each  program  in  the  Roadlog  subsystem  is  stored  in  load  module  format  in 
cataloged  library  HIS.LOADLIB,  from  which  it  is  retrieved  for  execution  by  the 
HIS  supervisor  when  requested.   The  member  name  for  each  program  is  given  with 
the  program  description. 

This  section  of  the  manual  presents  a  write-up  on  each  program  in  the 
Roadlog  subsystem.  An  attempt  has  been  made  in  the  source  listing  itself  to 
document  the  programs  with  appropriate  variable  names  and  comments. 

DUMP  — 

Member  Name DMR 

Language PL/I 

Subroutines  PRINTX1 

RLGCON 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  "dump"  listing 
ROADLOG  —  Roadlog  file 

Instruction 1  -  3  "DMR" 

40  -  52   Beginning  key 
56  -  68  Ending  key 

DUMP  provides  an  unformatted  listing  of  data  in  the  Roadlog  file,  between  user- 
specified  (by  means  of  the  DATA  parameter)  records  in  the  file.   Subroutine 
RLGCON  is  used  to  convert  the  Roadlog  records  into  character  format  for  print- 
ing.  Subroutine  PRINTX1  is  used  for  printer  output,  allowing  the  use  of  HIS 
formatting  options  in  printing.   RLGCON  is  never  invoked  at  its  initialization 
entry  point,  as  the  project  and  surface  type  tables  are  not  required  when 
converting  Roadlog  records  into  data  card  format.  Hence,  the  subroutine 
SRTYPR  (used  only  by  RLGCON  entry  points  RLGCON  and  C0V1)  does  not  need  to  be 
linked  into  the  load  module.   When  linking  without  this  subroutine,  the  LET 
option  must  be  specified  to  the  link  editor. 
The  DMR  program  listing  follows: 
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/*    ROADLOG  FILE  DUMP  */  ■ 


1 

2 

3 

4 

5 

6 

7 

8 

9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 

21 

22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 


/*  RGADLOG  FILE  DUMP  */ 

DUMP:  PROC(PARM)  OPT  IONS (MA  IN ) ;  L 

/*  INSTRUCTION  AND  PRINT  ROUTINE  */ 

DCL  r 

PARM  CHAR(IOO),  L 

INSTR  CHAR(80)  EXT, 

STARTKEY  CHAR(13)  DEF  INSTR  P0S(40), 

ENDKEY  CHAR(13)  DEF  INSTR  P0S<56), 

#_HDGS  PIC'Z1  DEF  INSTR  P0S(72),  ■ 

( PRINTER, HEADING! 9) I  CHAR(132)  EXT, 

PRINTX  ENTRY  (PIC'Z*  );  |" 

/*  DATA  INPUT  */  . 

DCL 

RECORD    CHARU20)     8AS  ED(PTR_RLG  J  , 

(CARD1,CARD2)  CHARC80), 

ROADLOG  FILE  RECORD  KEYED  INPUT  SEQL  ENV( I NDEXED ) ;  ■ 

/*****    INITIALIZATION    *****/ 

CALL  INIT(PARM); 

#_HDGS=2;  • 

HEADING(1)='  ROADLOG  DUMP'; 

OPEN  FILE(ROADLOG); 

ON  ENDFILE(ROADLOG)  BEGIN;  , 

PRINTER='    END  OF  FILE.'  ; 
CALL  PRINTX(3); 
GOTO  DONE; 
END;  ' 

READ  FILE(ROADLOG)  SET(PTR_RLG)  KEY( STARTKEY ) ; 
/*****    EXECUTION  LOOP    *****/ 

LOOP:  • 

CALL  C0V2  (CARD1, CARD2, RECORD) ; 

PRINTER  =  SU8STR(CARD1,2) I  I SUBSTR (C ARD2 , 15)  ; 

CALL  PRINTX(l); 

READ  FILE  (ROADLOG)  SET( PTR_RLG) ; 

IF  SUBSTR(REC0RD,2, 13)<=ENDKEY  THEN  GOTO  LOOP; 
DONE: 

CLOSE  FILE(ROADLOG) ;  « 

CALL  EXIT(PARM); 
END  DUMP; 
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LIST  — 

Member  Name PFR 

Language PL/ 1 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  Roadlog  listing 
ROADLOG  —  Roadlog  file 

Instruction 1-3   "PFR" 

40  -  52   Beginning  key 
56-68  Ending  key 

LIST  provides  a  listing  of  Roadlog  data,  in  a  more  easily  read  formatted 
version  than  that  provided  by  DUMP.   Data  conversions  are  performed  within 
LIST,  rather  than  by  RLGCON.   Not  all  of  the  Roadlog  data  items  can  be  shown 
in  the  listing.   Those  to  be  shown  are  declared  in  the  output  structure,  FRLG, 
The  items  to  be  printed  are  automatically  converted  and  moved  into  this 
structure  when  FRLG  is  set  equal  to  the  Roadlog  structure  RLG  by  name.   The 
section  length  is  also  accumulated  (the  accumulated  total  set  to  zero  at  the 
beginning  of  each  route  processed),  and  the  accumulated  value  printed.   In 
order  to  accumulate  the  section  length,  coincident  sections  must  be  scanned. 
Each  time  a  "CO"  record  is  found,  the  beginning  and  ending  key  of  the  coinci- 
dent section  is  formed  from  the  description,  and  the  records  retrieved. 
Although  the  records  are  not  printed,  the  section  length  on  each  record  in 
the  coincident  section  is  added  to  the  total. 
The  PFR  program  listing  follows: 
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/*  :LIST,FILE=ROADLOG,DATA=XXXXX  */ 

l:  /*  :LlST,FILE=ROADLOG,DATA=XXXXX  */ 

2:  LIST:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 

3:  /*****  DECLARATION  OF  VARIABLES  (ALPHABETICAL  ORDER)  *****/ 


4 
5 
6 
7 
8 
9 
10 
11 
12 
13 
14 
15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 
39 
40 
41 
42 
43 
44 
45 
46 
47 
48 
49 
50 
51 
52 
53 
54 


DECLARE 

#_HDGS  PIC'Z'  DEF  INSTR  POS(72), 

ACCUM_MILEAGE  P I C 111 VZZZ • ,  • 

C0DE(0:10)  CHAR(4)  STATIC  INIT 

('     », 'CITY* , 'CNTY' ,'NFOR' ,' IRES' , 'GAME' , 
•MRES» t 'NMON', 'NPRK' , 'SFOR' , 'SPRK' ), 
COIN_IND  CHAR (2» , 
DRLG  CHARU20)  STATIC, 
DFRLG  CHAR(132)  DEF  FRLG, 

ENDKEY  CHAR(13)  DEF  INSTR  P0S(56),  ■ 

F(0:9)  PIC'Z'  STATIC  INIT  (0,1,2,3,4,5,6,7,8,9), 
1   FRLG  STATIC, 

3       RT_#    CHAR(5) ,  L 

3       MILEPOST    CHAR( 10) , 

3      DESCR    CHAR(36), 

3       PROJ_CLASS    CHAR(5), 

3       YR.BLT    PIC'ZZB' , 

3       SURTYP    CHAR(4), 

3       SURF_WIDTH    PIC'ZZ' , 

3   RDWAY_WIDTH  PIC'ZZZ',  • 

3   LANES  PIC'ZZB', 

3   L0CN1  CHAR(5), 

3   L0CN2  CHAR (5) ,  [ 

3   ROUTE  PIC'ZZV.ZZZ' , 

3   SECTN  PIC ZZZV.ZZZ', 

3   CONST  PIC'ZZZV.ZZZ', 

3   UNIMP  PIC'ZZZV.ZZZ',  ■ 

3   WYE  PIC'ZV.ZZZ' , 

3   ACCUM_MLGE  P  IC  ZZZZV  .ZZZB  •  , 

3   REMARK  CHAR(3),  . 

3      COUNTY_#    PIC'ZZ  ', 

3   CITY_#  PIC'ZZZZB', 
HEADING(9)  CHAR(132)  EXT, 
INSTR  CHAR(80)  EXT, 
(KEY1,KEY2)  CHAR( 13) , 
PARM  CHAR(IOO), 

PRINTER  CHAR(132)  EXT,  • 

1  RLG  BASED(PTR_DRLG) , 

3   DUMMY1  CHAR(l), 

3   RT_#  CHAR(4) ,  , 

3  MILEPOST  CHAR(9) , 

3  REMARK  CHAR(2) , 

3  (SECTN, ROUTE, CONST, UNIMP)  DEC  FIXED(5,3), 

3  WYE  DEC  FIXED(3,3) , 

3  OESCR  CHAR(35) , 

3    PROJ_CLASS    CHAR(  11) , 

3    DIVIDED    CHAR( 1),  i 

3     (LANES, POPULATION_CODE)     DEC    FIXED(1,0), 

3     (CITY_#,COUNTY_#,YR_BLT,YR,FORHWY_*,ADMIN_CODE, 
LOCI  ,L0C2,  PRC)J_CL,SURF_WIDTH,RDWAY_WIDTH) 
DEC    FIXED(3,0),  ' 
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/*  :LIST,FILE=RGADLOG,DATA=XXXXX  */ 

55:        3  (SURF_THICKNESS,BASE_THICKNESS)  DEC  FIXED(3tl)» 

56:        3  SURF_TYPE_CODE  DEC  FIXED(1,0), 

57:        3  (SURF_TYPE,MAINT_SEC)  DEC  FIXEDC5,0>, 

58:        3  DATE, 

59:  5  (MONTHfDAY,YEAR)   DEC  FIXED(3,0), 

60:  RLGKEY  CHARU3)  DEF  DRLG  P0S(2), 

61:  ROADLOG  FILE  RECORD  KEYED  ENVC INDEXED ) , 

62:  SAVE_KEY  CHAP (13) , 

63:  SAVE_RT_#  CHARC4), 

64:  STARTKEY  CHARC13)  DEF  INSTR  P0SC40), 

65:  TYPE(0:8)  CHAR(3)  STATIC  INIT 

66:        (•    »  ,'PRM"  , 'BLO'  .'GRD', 'GRV  .'BSTS'RMS' , 'PMSS 'PCC1  )  ; 

67:  /*****  PROGRAM  INITIALIZATION  *****/ 

68:  CALL  INIT  (PARM); 

69:  /***  SET  UP  PAGE  HEADINGS  ***/ 

70:  #_HDGS  =  3; 

71:  HEADING(I)    =     ■  MILE 

72 :  ||'  Yk    SUR    WIDTH  '     I  I 

73:        • ************  LENGTH  ************   ACCUM1; 

74:  HEADING(2)  =  *RT_#     POST    *******  SECTION  DESCRIPTION  ********* 

75:        ||  'PROJ  BT  TYP  SF  RD  L  LOCATIONS  »  II 

76:        •  ROUTE   SECTN   CONST   UNIMP   WYE  MILEAGE  RE  CY  CITY'; 

77:  /***  INITIALIZE  ROADLOG  FILE  ***/ 

78:  OPEN  FILE  (ROADLOG)  INPUT; 

79:  ON  ENDFILE  (ROADLOG)  GOTO  RETURN; 

80:  READ  FILE  (ROADLOG)  INTG  (DRLG)  KEY  (STARTKEY); 

81:  PTR_ORLG=ADDR(DRLG); 

82:  SAVE_RT_#  =  •  »; 

83:  /*****  main  CONTROL  SECTION  *****/ 


84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 

100 

101 

102 

103 

104 


LOOP: 

IF    RLG.RT_#-=SAVE_RT_#    THEN    DO; 
ACCUM_MILEAGE    =    0; 
FRLG.ACCUM_MLGE    =    0; 

J   =    3; 

SAVE_RT_#    =    RLG.RT_#; 

END; 

FRLG=RLG,     BY    NAME; 
FRLG.L0CN1    =    CODEC RLG. LOC 1 ) ; 
FRLG.L0CN2    =    CODE ( RLG. L0C2 ) ; 
DO    Jl=3    TO    4; 

IF    SUBSTR(FRLG.PR0J_CLASS,J1-1, 1)=«     •    THEN 
SUBSTR(FRLG.PR0J_CLASS,J1,1 )    =     '     •; 

END; 
FRLG.SURTYP    =    TY PE ( RL G. SURF_TYPE_CODE ) ; 
ACCUM_MILEAGE    ■    ACCUM_M ILE AGE    «■    RLG. SECTN; 
IF    RLG.REMARK='     ■     |     RLG.REMARK= * S P •     I     RLG .RFMARK= ' LP • 

RLG.REMARK=»NE»     I     RLG. REMARK= • OS •     THEN 

FRLG.ACCUM_MLGE    =    ACCUM_M I LEAGE ; 
ELSE     IF    RLG.REMARK='CO'     I     RLG. REM ARK= • IL • 

THEN    CALL     COPROCESSOR; 
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/*  :LIST,FILE=ROADLOG,DATA=XXXXX  */ 

105:  PRINTER  =  DFRLG; 

106:  CALL  PRINTX  (F(J)); 

107:  J  *  lj 

108:  READ  FILE  (ROADLOG)  INTO  (DRLG); 

109:  IF  RLGKEYOENDKEY  THEN  GOTO  LOOP;  - 

- 
110:  RETURN: 

111:     CLOSE  FILE  (R0A9L0G); 
112:     CALL  EXIT  (PARM); 
113:     RETURN; 

■■ 

114:  /*****  SUBROUTINE  TO  PROCESS  COINCIDENT  SECTIONS  *****/ 


115 
116 
117 
118 
119 
120 
121 
122 
123 
124 
125 
126 
127 
128 
129 
130 
131 
132 
133 
134 
135 
136 
137 
138 
139 


CO_PROCESSOR:   PROCEDURE; 
COIN_IND  =  RLG. REMARK; 

KEY1  =  SUBSTR(RLG.DESCR,6,4)  ||  SUBSTR (RLG. DESCR ♦ 1 6, 9 )  ; 
KEY2  =  SUBSTR(RLG.DESCR,6,4)  II  SUBSTR {RLG. OESCR t 26, 9) ; 


SAVF_KEY  =  RLGKEY; 

ON  KEY  (ROADLOG)  BEGIN; 

CALL  ASTER; 

PRINTER  =  •***  NO  RECORD  FOR  KEY  •  I  I  KEY1; 

CALL  PRINTX  ( F(2) )  ; 

CALL  ASTER; 

GOTO  BACK; 

END; 
READ  FILE  (ROADLOG)  INTO  (DRLG)  KEY  (KEY1); 
KEY1  =  KEY2J 
KEY2  =  RLGKEY; 

READ  FILE  (ROADLOG)  INTO  (DRLG)  KEY  (KEY1); 
IF  COIN_IND=» IL'  THEN  GOTO  BACK; 
KEY1  =  KEY2; 
KEY2  =  RLGKEY; 

READ  FILE  (ROADLOG)  INTO  (DRLG)  KEY  (KEY1); 
DO  WHILE  (RLGKEY<KEY2); 

ACCUM_MILEAGE  =  ACCUM_M IL EAGF  ♦  RLG.SECTN; 

READ  FILE  (ROADLOG)  INTO  (DRLG); 

END; 
FRLG.ACCUM_MLGF  =  ACCUM_H I LEAGE ; 


- 


140:  BACK: 

141:     READ  FILE  (ROADLOG)  INTO  (DRLG)  KEY  (SAVE_KEY); 

142:     END  CO_PROCESSOR ; 

143:  END  LIST; 
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LIST-ILOOPS  — 

Member  Name LIR 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  LIST-ILOOPS  output 
ROADLOG  —  Road log  file 

Instruction 1-3   "LIR" 

LIST-ILOOPS  prints  a  listing  of  all  of  the  Interstate  loops  in  the  Roadlog 
file.   An  Interstate  loop  is  a  stretch  of  Interstate  highway  parallel  to  a 
Primary  route.   A  record  containing  remark  code  "IL"  appears,  in  the  Primary 
route,  defining  the  beginning  and  ending  of  a  loop.   The  program  scans  the 
entire  Primary  route  system  for  "IL"  records,  forms  the  beginning  and  ending 
keys  from  the  description,  and  lists  the  records  in  the  loop.   Mileage  is 
accumulated  for  each  loop,  and  the  mileage  printed  after  the  loop  listing. 
After  the  entire  listing,  the  total  Interstate  loop  mileage  is  printed.   The 
purpose  of  LIST-ILOOPS  is  to  aid  in  the  production  of  the  Interstate  and 
Primary  summary  by  location  in  the  Federal  Aid  Roadlog  report.   In  this 
summary,  the  status  of  the  7%  system  is  reported.   The  7%  system  allows  for 
subtraction  of  Interstate  loops  which  are  located  outside  Federal  reservations 
and  are  not  urban  (urban  loops  are  deducted  when  urban  extensions  are  taken 
out).   Hence,  the  program  shows  the  mileage  in  three  categories:   that  which 
is  urban,  that  which  is  non-urban  outside  Federal  reservations,  and  all  other. 
Each  record  is  flagged  with  one  of  the  codes  "URB,"  "OUT,"  and  blank  to 
indicate  the  mileage  type  of  that  record. 
The  LIR  program  listing  follows: 
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/*    :LIST_ILOOPS,FILE=ROADLOG    */ 


1 
2 
3 
4 
5 
6 
7 
8 
9 
10 
11 
12 
13 
14 
15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 
39 
40 
41 
42 
43 
44 
45 
46 
47 
48 
49 
50 
51 
52 
53 
54 
55 
56 
57 
58 


/*     :|_IST_ILOOPS,FILE=RfUDLOG    */ 
ILOOP:     PROC(PARM)    OPT IONS( MAIN ) ; 
/*     INSTRUCTIONS    */ 
DCL 
INSTR    CHAR(80)     EXT, 
#_HOGS    PIC'Z'     DEF     INSTR    P0S(72>; 
/*    PRINT    SUBROUTINE    */ 
OCL 
PAKM    CHAR(IOO), 
HEA0INGI9)    CHAR( 132IEXT, 
PRINTER    CHAPU32) EXT, 
PRINTX    ENTRY(PICZ' )  , 
PRINTXA    ENTRY(PIC  Z»  ,PICZZ«  ); 
/*    40ADL0G    FILF    */ 
DCL 
1    RLG    BASED(PTR_RLG) , 
3    DUM1    CHAR(2>, 
3     (RT_#,MILEPOST)    PICZZZ1, 
3    OFFSET    CHARI6) , 
3    REMARK    CHARC2) , 
3    (SECTN, ROUTE)     DEC    FIXED(5,3), 
3    DUM2    CHAR (8) , 
3    DESCR    CHARI35) , 
3    PROJ    CHAR( 11 ) , 
3    DUM3    CHAR(2) , 
3    POP    DEC    FIXED! 1,0), 
3     (CITY_#,COUNTY_# ,YR_BLT, YR_IMP,DUM6, DUMM7,L0C1 , L0C2 , 

DUM7,S_WD,R_WD)    DEC    FIXED(3,0), 
3    DUM8    CHAR(5), 

3     (SURF_TYPE,DUM9)     DEC    FIXED(5,0), 
3    DATE, 

5     (MONTH, DAY, YEAR)     DEC    FIXED{3,0), 
3    DUMMY2    CHAR (2) , 
1    RLGA    BASED(PTR_RLG) , 
3    0UM1    CHAR( 1) , 
3    KEY    CHAR( 13) , 
3    DUM2    CHAR (22) , 
3    RT_#    CHAP(3) , 
3    DUM3    CHAR(6) , 
3    MPi    CHAR(9), 
3    DUM4    CHAR( 1) , 
3    MP2    CHAR(9) , 
ROADLOG    FILE    RECORD    KEYED    ENV ( I NDEXED ) ; 
/*    OUTPUT    STRUCTURE    */ 
DCL 
OUT    CHARU32)     STATIC     INITC     •), 
1    0    DEF    OUT    P0S(8) , 
3    MILEPOST    PIC^ZZ1, 
3    OFFSET    CHAR(8) , 
3    DFSCR    CHAR( 37) , 
3    PROJ    CHAR (13) , 
3    REMARK    CHAR(4) , 
3    COUNTY_#    PIC^ZZBB' , 
3     (L0CN1,L0CN2)     CHAR(5), 
3    POP    PIC  ZZ'  , 
3    CITY_#    PIC  ZZZBB'  , 
3    YR_BLT    PIC1 ZZB' , 
3    YR_IMP    PIC  ZZBB'  , 
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/*    :L I ST_I LOOPS ,FI LE=ROADLOG    */ 


59 

60 

61 

62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 

80 

81 

82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 

100 

101 

102 

103 

104 

105 

106 

107 

108 

109 

110 

111 

112 

113 

114 

115 

116 


3  SURF.TYPE  PICZZZZBB', 
3  S_WO  PIC  ZZB», 
3  R_WO  PICZZBB'  , 
3  ROUTE  PIC  ZZV.ZZZBB*, 
3  SECTN  PICZZV.ZZZBB' , 
3  CODE  CHAR (3) ; 
/*  OTHER  VARIABLES  */ 
DCL 
(KEY1,KEY2)  CHARU3), 
SAVEKEY  CHAR( 13) , 
CNTR  PICZZ9*  STATIC  TNIT(O), 
(MP1,MP2)  CHAR(9), 
X  PIC'Z1, 

MILES(2,3)  DEC  FIXED  (7,3)  STATIC, 
C00E(3)  CHAR(3)  STATIC  IN  I T{  • OUT* , • URB» , •  •) 
/****INITI ALIZATION  ***/ 

CALL  INIT  (PARM); 
/*  SET  UP  HEADINGS  */ 
#_HDGS=5; 

SUBSTR(HEADING( 1 ) , 72 ) = • POADLOG  INTERSTATE 
HEADING(3)=«  MILE 

II  •    PROJECT  CY  CITY   YEARS   SURF   WIDTH 

I  I  •***  LENGTH  ***' ; 

HEADING(4)=»  POST         SECTION  DESCRIPTION 

II  •    NUMBER       RE   NO    LOCATIONS  NMBR   BT  IM   TYPE   SF  RD 

II  'ROUTE   SECTION1; 
/*  INIT  FILE  */ 

OPEN  FILE(ROADLOG)  INPUT  SEOL; 

READ  FILE(ROADLOG)  SET(PTR.RLG)  KFY(»P001»); 

ON  KEY  (ROADLOG)  BEGIN; 

PRINTERS***  NO  ROADLOG  RECORD  FOR  KEY  ■  I  I  KEY1; 
CALL  PRINTXI3); 
GOTO  RESTART; 
END; 
MILES  =  o; 
/*****  MAIN  EXECUTION  LOOP  ****/ 
LOOP: 
IF  RLG.KEMARK-.=  »  IL'  THEN  GOTO  RFAO_RFCORD; 
CNTP=CNTR+l; 

PRINTERS   INTERSTATE  LOOP   #»  II  CNTR; 
CALL  PRINTXA<5,12); 

PRINTERS      PRIMARY  ROUTE  'II  RLG.RT_#; 
CALL  PRINTXI2); 
MP1=RLGA.MP1; 
MP2=RLGA.MP2; 
PRINTERS      LOOP  ON  INTERSTATE  ROUTE  •  I  I  RLGA.RT_#  II 

•  FROM  MILEPOST  »||MP1||  •  TO  »|l  MP2; 
CALL  PRINTX(l); 
X  =  2; 

MILES(1,*)=0; 

KEY1=SUBSTR<RLG.DESCP,6,4) |  |  SUBSTR ( RLG. DESCR , 16, 9  )  ; 
KEY2=SUBSTR< RLG. DESCR ,6,4) | | SUBSTR ( RLG. DESCR , 2  6, 9) ; 
SAVEKEY=RLGA.KEY; 

READ  FILE(ROADLOG)  SET(PTR_RLG)  KEY(KEYl); 
DO  WHILE(RLGA.KEY<KEY2)  ; 

IF  RLG.P0P>=4  THEN  I  =  2; 

ELSE  IF  RLG.L0C2-=0  £  RLG.L0C2-=9  | 

RLG.L0C1-=1  C  RLG.L0Cl-=2  &  RLG.L0Cl-.=9  THFN  I  =  3; 
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/*   :list_iloops,file=roadlog  */ 


: 


117 

118 

119 

120 

121 

122 

123 

124 

125 

126 

127 

128 

129 

130 

131 

132 

133 

134 

135 

136 

137 

138 

139 

140 

141 

142 

143 

144 

145 

146 

147 

148 

149 

150 

151 

152 

153 

154 

155 

156 

157 

158 


ELSE  1=1; 
MILESC 1,1 )=MILES<1, I)  ♦  RLG.SFCTN;  [ 

OUT  =  •  •; 

0=RLG,BY    NAME;  r 

IF    PLG.REMARK=»     '     I     RL G.REMARK= • SP •      I     RLG.REM  AR  K=  «  LP  ■     I 

RLG.REMARK=«NE«  I  RLG.REMARK= • OS •  THEN  O.COOE  =  CODEC  I);       * 
PRINTER=OUT; 
CALL  PRINTX(X); 
x=l; 
READ  FILE(ROADLOG)  SET ( PTR_RLG ) ; 

end; 


[ 

:ND  ' '  f 

RESTART:  READ  F IL E { ROADLOG)  SFT(PTR_RLG)  KF Y( SAV EKF Y) ; 


MILES(2,*)  =  MILES(2t*»  ♦  MILESU,*); 
PRINTERS  ***  MILEAGES  FOR  LOOP  ***•  ; 

CALL  PRINTXA(3,10); 
PRINTERS      OUTSIDE  FEDERAL  RESERV.   •  II  MILESU, 1>; 

CALL  PRINTX(2>; 

PRINTERS  URBAN   •  II  MILES(1,2); 

CALL  PRINTX(l); 

PRINTER**  ALL  OTHER   '  II  MILES(1,3); 

CALL  PRINTX(l); 

MILES(1,3)=MILES(1,1)+MILES(1,2)+MILES(1,3); 
PRINTER*'  TOTAL   •  II  MILESU, 3); 

CALL  PRINTXC2); 
READ_RECORD: 

READ  FILE(ROADLOG)  SET  (PTR_RLG); 

IF  RLGA.KEY<«S»  THEN  GOTO  LOOP; 

PRINTERS      TOTAL  INTERSTATE  LOOP  MILEAGES'; 

#_HDGS  =  2; 

CALL  PRINTXA  (6,13) ; 
PRINTER*'     OUTSIDE  FEDERAL  RESERV.    •  II  MILES(2,1>; 
CALL  PRINTX(2); 

PRINTER*'  URBAN    ■  II  MILES(2,2); 

CALL  PRINTX(l); 

PRINTER*'  ALL  OTHER    '  II  MILES<2,3>; 

CALL  PRINTX(l); 

MILES(2,3)=MILES(2,1)*MILES(2,2)+MILES(2,3); 
PRINTER*'  TOTAL   •  II  MILES(2,3); 

CALL  PRINTXC2)  ; 
CLOSE  FILE(ROADLOG) ; 
CALL  EXIT  (PARM); 
END  ILOOP; 
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UPDATE  —  UPDATE  is  comprised  of  four  separate  programs,  one  for  each 
of  the  functions  DELETE,  INSERT,  REWRITE,  and  NEW-KEY.   The  names  of  the 
routines  are  "PDR"  followed  by  the  first  letter  of  the  function  (e.g.,  "PDRD' 
for  FUNCTION=DELETE) . 

FUNCTION=DELETE: 

Member  Name PDRD 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  --  IBM  messages 

PRINTER  —  UPDATE  messages 

ROADLOG   —  Road log  file 

any  name  —  Road log  data  cards 

Instruction 1  -  4   "PDRD" 

24  -  31  Name  of  input  DD  statement 

The  user  codes,  by  means  of  the  DDNAME  parameter  on  the  UPDATE 
command,  the  name  of  the  DD  statement  he  will  supply  with  deletion 
data.   Each  card  read  via  this  DD  statement  contains,  in  columns 
1-13,  the  key  of  a  record  to  be  deleted.   The  program  operates 
with  a  direct  update  Roadlog  file;  each  time  a  card  is  read,  a 
PL/I  DELETE  statement  specifying  the  key  on  the  card  is  executed. 
If  the  key  condition  is  raised  (the  specified  record  did  not 
exist  in  the  file),  an  error  message  is  printed.   Each  data  card 
is  printed  as  it  is  read. 

The  PDRD  program  listing  follows: 
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/*  :UPDATE,FILE=RGADLOG,FUNCTION=DELETF,DDNAME=XXXXX  */ 

l:  /*  :UPDATEtFILE=R0A0LOGfFUNCTION=DELETE,0DNAME=XXXXX  */ 

2:  DELETE:   PROCEDURE  (PARM)  (JPT1UNS  (MAIN); 

3:  /*  INSTRUCTION  */ 

4:  DECLARE 

5:      IN5TR  CHAR(80)  EXT, 

6:     #_HDGS  PIC'Z*  OEF  INSTR  POS(72)t 

7:     DDNAME  CHAR(8)  DEF  INSTR  P0S(24); 

3:  /*  PRINT  ROUTINE  */ 

9:  DECLARE 
10:     RARM  CHAR( 100)  , 

11:    (HFADING(9) tPRINTER)  CHAR(132)  EXT, 
12:     PRINTX  EIMTPY  (PIC'ZM; 

13:  /*  PERMANENT  FILE  */ 

14:  DECLARE 

15:     PERMDO  CHAR(8)  STATIC  INIT  (*ROAOLOG'), 

16:     PERM  FILE  RECORD  KEYED  ENV  (INDEXED); 

17:  DECLARE 

18:     DATA  FILE  RECORD, 

19:     KEY  CHARI13)  BASED  (PTR_DATA); 


20:  /*****  INITIALIZATION  *****/ 
21:     CALL  INIT  (PARM); 

22:     /*  SET  UP  HEADINGS  */ 
23:     #_HDGS  =  2; 

24:     HEADING(l)  =  PERMDO  I  I  'FILE  UPDATE  —  DELETION  0^  RECORDS1; 


25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 


/*  OPEN  FILES  */ 

ON  UNDEFINEDFILE  (DATA)  BEGIN; 

PRINTER  =  '***  ■  ||  DDNAME  I |  •  DD  STATEMENT  MISSING*; 

CALL  PRINTX  (3); 

GOTO  RETURN; 

END; 
OPEN  FILE  (DATA)  INPUT  RECORD  TITLE  (DDNAME); 
ON  ENDFILE  (DATA)  GOTO  CLOSE; 

OPEN  FILE  (PERM)  UPDATE  DIRECT  TITLE  (PERMDO); 
ON  KEY  (PERM)  BEGIN; 

PRINTER  =  •***  RECORD  DOES  NOT  EXIST  IN  FILE*; 

CALL  PR INTX  (  1)  ; 

GOTO  READ_DATA; 

END; 


39:  /*****  MAIN  EXECUTIJN  LOOP  *****/ 

40:  READ_DATA: 

41:     RFAD  FILF  (DATA)  SET  (PTR_DATA); 

4?:     PRINTER  =  '      'II  KEY; 

43:     CALL  PRINTX  (2); 

44:     DELETE  FILE  (PERM)  KEY  (KEY); 

45:     GOTO  READ.DATA; 

46:  CLOSE: 
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/*  :UPDATEtFlLE=ROADLOG»FUNCTlON=DfcLETF,DONAME=XXXXX  */ 

47:  CLOSE  FILE  (PERM); 
48:  CLOSE  FILE  (DATA ) ; 
49:     CALL  EXIT  (PARM) ; 

50:  RETURN: 

51:  END  DELETE; 
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FUNCTION=INSERT ; 

Member  Name PDRI 

Language PL /I 

Subroutines  PRINTX1 

RLGCON 

SRTYPR  (used  by  RLGCON) 

Files  .  . SYSPRINT  —  IBM  messages 

PRINTER  —  UPDATE  messages 

ROADLOG   —  Roadlog  file 

PROJTBL   —  Project  class  table  (RLGCON) 

SURFTBL   —  Surface  type  table  (SRTYPR) 

any  name  —  Roadlog  data  cards 

Instruction 1  -  4   "PDRI" 

24  -  31  Name  of  input  DD  statement 

Data  cards,  when  inserting  records,  contain  a  complete  Roadlog 
record.   A  two-card  sequence  is  required  for  coding  all  Roadlog 
fields.   Descriptor  records,  however,  may  be  specified  with  a 
single  card.   The  data  card  formats  may  be  found  in  the  publication 
Highway  Information  System  Volume  1:   User  Information.   The  first 
card  always  contain  a  "1"  in  column  1  of  a  data  card ,  and  the 
second  card  contains  a  "2."  Both  card  types  contain  the  key  in 
columns  2  through  14.   The  program  reads  a  card,  and  checks  for 
a  "1."   If  not  present,  an  error  message  is  generated.   If  the 
card  contains  a  "1,"  a  second  card  is  read.   If  this  card  either 
does  not  contain  a  "2,"  or  contains  a  key  other  than  that  on  the 
first,  the  program  assumes  that  only  one  card  has  been  supplied 
for  that  record.   If  the  remark  code  specifies  a  mileage  record 
(blank,  "LP,"  "SP,"  "OS,"  or  "NE") ,  an  error  message  is  generated, 
and  the  record  not  inserted.   After  inserting  the  record  (or 
printing  an  error  message  if  a  record  already  exists  with  the 
specified  key,  raising  the  key  condition),  the  program  then 
returns  to  the  beginning  of  the  loop.   If  the  second  card  read 
was  not  the  "2"  card  for  the  preceding  "1"  card,  it  is  used; 
otherwise,  another  card  is  read.   The  end-of-file  condition 
may  be  raised  when  attempting  to  read  a  second  card.   If  this 
occurs,  the  record  is  inserted  (if  a  descriptor  record),  and 
the  program  terminates.   Subroutine  RLGCON  performs  the  conversion 
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of  the  two-card  sequence  (the  program  sets  up  a  dummy  second 
card  for  descriptor  records  not  having  a  second  card)  into 
the  standard  Roadlog  file  format. 

The  PDRI  program  listing  follows: 
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INSERT:  PROC(PARM)  OPT  IONS ( MA  IN  ) ; 


1 
2 
3 
4 
5 
6 
7 
8 
9 
10 
11 
12 
13 
14 
15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 
39 
40 
41 
42 
43 
44 
45 
46 
47 
48 
49 
50 
51 
52 
53 
54 
55 
56 
57 
58 


INSERT:  PROC(PARM)  OPT  IONS (MAIN  )  ; 

/*   :UPDATE,FILE=ROADLOG,FUNCTION=INSERT,DDNAME=XXXXX  */ 
DECLARE 
INSTR  CHAR(80)  EXT, 

DONAME  CHAR<8>  OEF  INSTR  P0S(24), 
#_HDGS  PIC'Z'  OEF  INSTR  P0S(72), 
PARM  CHAR( 100)  , 

( HEADING! 9) , PR  INTER )CHAR(  13  2)     FXT, 
PRINTXA    ENTRY     ( P I C ' Z • , P I C » Z Z '  )  , 
PRINTX    FNTRY(PIC Z«  )  , 
RECOKD    CHAR( 120), 
(CARD1,CARD2)CHAR (80) , 
(FLAG,FLAG1)     BIN    FIXED, 

PFRMDD  CHAR(8)  STATIC  IN  I  T (  • R UAULOG •  )  , 
DATA  FILE  RECORD, 

PERM  FILE  RECORD  KEYED  ENV(  INDEXED  )  , 
CD  CHAR(80)  IN  IT (  •  •  ), 
CARD  CHAR(80)  BASED  (PTR), 
TYPE_CODE  CHAR(l), 
KEY  CHAR  (13) , 
CI  (80)  CHAR  (1)  DEF  CARD1, 
CCUNTY_#  PIC'ZZ'  DEF  CARD1  P0S(67), 
CITY_#  PIC'ZZZ'  OEF  CARD?  P0SI18), 
C2  (80)  CHAR(l)  DEF  CARD2, 

C3  DEC  FIXED(3,0), 
C4  CHAR (2)  ; 
/** INITIALIZATION**/ 
CALL  IN  IT  (PARM); 

CALL  RLGCON; 
tf_HDGS=2; 

HEADING( 1 )  =  PERMDD|  I  'FILE  UPDATE — INSERTION  OF  RECORDS'; 
ON  UNDEFINEDFILE( DATA)  BEGIN; 

PRINTER=»**»  |  I DDNAME I  I  'DD  STATEMENT  MISSING'; 
CALL  PRINTX (3) ; 
GOTO  FINISH; 
END; 

OPEN  FILE! DATA)  INPUT  RECORD  TITLE f ODNAMF  )  ; 
ON  ENDFILE(DATA)  GOTO  FINISH; 

UPFN  FILE(PERM)  UPDATE  DIRECT  T  I  TLF ( PERMDD )  ; 
ON  KEY(PERM)  BFGIN; 
PR INTER='***ATTEMPT  TO  INSERT  OVFR  EXISTING  RECORD*; 
CALL  PRINTX( 1) ; 
PRINTERS  •; 
CALL  PRINTX(l); 
GOTO  READ_DATA; 
END; 
ELAG=0;   FLAG1=0; 
/*  EXECUTION  LOHP  */ 
READ.DATA: 

IF  FLAG1=1  THEN  GOTO  CLOSE; 
IF  FLAG=0  THFN  READ  FILE(DATA)  SET(PTR); 
FLAG=0; 

PR INTER='       ' I | CARD; 
CALL  PRINTX  (?); 
IF  SUBSTR(CARD,  1,  1  )-.=  •  1'  THEN  DO; 

PR INTER=,**FRRUR  IN  CARD  CODE,  COLUMN  1,  RECORD  NOT  INSFRTED' 
CALL  PRINTX! 1); 
PRINTERS  '  ; 
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INSERT:     PROC(PARM)     OPT  IONS ( MA  IN ) ; 


59 

60 

61 

62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

7H 

79 

80 

81 

82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 

100 

101 

102 

103 

104 

105 

106 

107 

108 

109 

110 

111 

112 

113 

114 

115 

116 


CALL  PRINTX(l); 
IF  FLAG1=1  THEN  GOTO  CLOSE; 
READ  FILE(DATA)  SET(PTR); 

IF  SUBSTR(CARD, 1,1)='2«  THEN  GOTO  RFAO_DATA; 
Fl AG=l; 

GTTO  READ_OATA; 
END; 
IF  SUBSTR(CARD,9,1)=' +•  THEN  00; 
TYPE_CODE=' L« ; 
KEY=SUBSTR(CARD,2, 13) ; 
CAR01=«  • | I SU8STR(CAR0,2) ; 
END; 

ELSE  DO; 
TYPE_CODE='S' ; 
K EY= SUBSTR (CARD, 2,9 ) ; 
CARD1=«  'II SUBSTR(CARD,2,7)  |  |  •  +0  .  •  I  I SUBSTR { C AR 0 , 9 , 2 )  |  | »0» |  I 

SUBSTR1CAPD, 11 ,66); 
END; 
READ  FILE(DATA)  SET(PTR); 
IF  FLAG1=1  THEN  GOTO  CLOSE; 
IF  SUBSTR(CARD,1  ,  1  ) -= • 2  '  THEN  GQTfj  DS; 
IF  TYPE_CODE=•L,  £  SUB  STR  {  C  ARD  ,  2  ,  1  3  )  -=K  E  Y  |  TYPF_COOE  =  •  S  •  L  SUBSTR 
(CARD, 2, 9)-.=  KEY  THEN  DC; 
C4=SUBSTR(CARD1,65,2); 

IF  C4='  • |C4='NE' I C4='SP' |C4='LP ■ |C4='0S«  THEN  DO; 
PRINTER='**2ND  CARD  MISSING,  REQUIRED  F0»  MILEAGE  RECORD,'  I  I 
•  RECORD  NOT  INSERTED' ; 
CALL  PRINTX(I); 
PFINTER='  '; 
CALL  PRINTX(l); 
FLAG=3; 
GOTO  READ_DATA; 

END; 
ELSE  DO; 
FLAG=3; 
GOTO  CNVl; 

fnd; 
END; 
S2: 

PRINTERS       « | ICARD; 

CALL  PRINTX(l); 
IF  TYPE_CODE=«L'  THEN  CARD?= •  '  I  I SUBSTR { C ARD 1 , 2 , 1 3 )  I  I SUBSTR ( C ARD , 
15)  ; 
ELSE  CARD2=«  • |  | SUBSTR (CARD  1 , 2. 13 ) I | SUBSTR < CARD , 1 1 ) ; 
FL  AG-O; 

GOTO  CONl; 
DS:    C4=SUBSTR(CARD1 ,65,2) ; 
IF  C4=«  •  |C4=«NE«  | C4=«LP'  |C4='0S'  |C4=« SP •  THEN  GOTO  ESC; 
GOTO  CNVl; 
ESC: 

PRINTERS       ■ j  ICARD; 

CALL  PRINTX(l); 

PRINTER='**CARO     INCORRECT,     EITHER     INCORRECT    KEY,     DUPLICATE    CARD    OR' 

I  I  '     OUT    OF    SFQUENCE**' ; 
CALL    PRINTX(l) ; 
FLAG=1J 
GOTO    READ_DATA; 
CNVl:     CARD2='     '  I  I  SUBS TR ( CARD1 , 2 , 13 ) |  I  SUBS TR ( CD , 14 )  ; 
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INSERT:  PROC(PARM)  OPTIONS (MA  IN ) 


117 
118 
119 
120 
l?l 
122 
123 


125 

126 

127 

128 

129 

130 

131 

132 

133 

134 

135 

136 

137 

138 

139 

140 

141 

142 

143 

144 

145 

146 

147 

148 

149 

150 

151 

152 

153 

154 

155 

156 

157 

158 

159 

160 

161 

162 

163 

164 

165 

166 

167 

168 

169 

179 

171 

172 

i  n 

174 


CONl: 

C4=SU8STR(CARD1,6  5,2); 

IF  C4=«0S« |C4='ER« |C4=,EN« |C4=,C0' |C4=» 
00  1=3  TO  8,10,12  TO  14,50  TO  53,67  TO 
IF(C1<  IK'O'  |Cl(n>,9MGCK  (>-='  •  TH 
PRlNTER=,***ERPOR  IN  CODING  CARD 
•  SHOULD  BE  NUMERIC 
CALL  PRINTX(l)  ; 
PRINTERS  '; 
CALL  PRINTX(l); 
GOTO  rfad_data; 
end; 
end; 

DO  1=15,17  TO  66; 

IF<C2(IXI0«|C2(I)>,9M&C2(I)- 

PRINTERS ***FRROR  IN  CODING 


IL« 

72; 
EN  do; 

LUMN:  • I 
OR  BLANK,  PECOS 


THEN  GOTO  INST; 


III  I1 

D  NUT 


ON  C 

I  N  S  F:  K 


ARD1'  I 
T  F  0  •  ; 


r 

c- 

i  [ 
[ 


=  •  »  TH 

CARD  CO 
OR  BLAN 


EN  DO; 
LUMN:  •  I 
K,  RECOR 


mi1 

D  NOT 


ON  C 

INSER 


Cl( 2)-=,S' 

SYSTEM  COD 


THEN  DO 
E  -  RECO 


RO  NOT  INSFPTED'  ; 


M  CODE  -  RECORD  NOT  INSERTED1; 


•  SHOULD  BE  NUMERIC 
CALL  PRINTX(l); 
PRINTERS  *; 
CALL  PRINTX(l); 

GOTO  read.data; 

END; 

end; 

IF  01(21-1=*  I  •  &  C1(2)-.=  'P'  & 

printer=****err0r  in  route 

call  ppintx(  1)  *, 
printers  '; 

goto  read_oata; 

fnd; 

IF    C0UNTY_#>56    THEN    DO; 

PRINTFk= '***ERRUR     IN    COUNTY_ 
CALL     PRINTX(l); 
PRINTERS     '; 
CALL     PRINTX( 1 ) ; 
GOTO    READ_DATA; 
END; 
IF     CITY_#>126    THEN    DO; 

PRINTER='***ERROR     IN    CITY    NUMBER 
CALL     PRINTX(l); 
PKINTER='     ■ ; 
CALL     PRINTX(l); 
GOTO    READ_DATA; 

END; 
INST:     CALL    COV I ( C AR Dl , CARD? , R ECORD  )  ; 

WRITE     FILE(PERM)     FROM(RFCORD)     K FYFROM (  SUBSTR ( RhCORO  ,  2  ,  13 )  )  ; 
GOTO    READ_DATA; 
F INISH: 

IF     SUBSTR(CARD,1,1 ) -= ' 1 '      I     »=LAGl=l     THf 
C4=SUBSTR(CARD,65,?); 
!P    C4-.=  »     •6C4-i='NE,&C4-=,SP,&C4-.=  ,LP,£C 

FLAGl=l; 
GUTO    CNV1 ; 

fnd; 
clse   do; 

FLAG=l; 
FLAGl'l; 

GOTO    ESC; 
CLOSE:     PRINTFR= 


ARD2' 
TED*  ; 


cnnt.  _  RECORD  NUT  INSERTED1  ; 


N  GOTO  C 
4-.=  ,0S» 


LOSE  ; 

THEN  D 


o; 


****fNO  qf  DATA  ***** 
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INSERT:     PROC(PARM)     OPT  I CNS ( MA  IN  ) 


175 
176 
177 
178 
179 


EN!) 


CALL  PRINTXO); 
CLOSE  FILE(PERM) ; 
CLOSE  FILE(OATA) ; 
CALL  EXIT  (PARM); 
INSERT; 
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FUNCTION=REWRITE: 

Member  Name PDRR 

Language PL/I 

Subroutines  PRINTX1 

RLGCON 

SRTYPR  (used  by  RLGCON) 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  UPDATE  messages 

ROADLOG  —  Roadlog  file 

PROJTBL   —  Project  class  table  (RLGCON) 

SURFTBL   —  Surface  type  table  (SRTYPR) 

any  name  —  Roadlog  data  cards 

Instruction 1  -  4   "PDRR" 

24  -  31  Name  of  input  DD  statement 

Data  cards  for  rewriting,  though  in  the  same  format  as  those  for 
inserting,  require  only  fields  being  altered  to  be  coded.   Hence, 
a  "1"  card,  a  "2"  card,  or  both  may  be  supplied.   Because  of  the 
low  volume  of  updates  performed  on  the  Roadlog  file,  the  program 
operates  with  one  card  at  a  time.   Hence,  if  both  cards  are 
included,  two  separate  rewrites  will  be  performed.   This  method 
of  operation  greatly  simplifies  the  program  logic.   The  program 
reads  one  data  card.   If  the  card  is  a  "1"  card,  a  dummy  "2" 
card  is  set  up;  if  it  is  a  "2"  card,  a  dummy  "1"  card  is  set  up. 
The  Roadlog  record  is  then  read,  and  RLGCON  used  to  convert  it 
into  character  format.   The  record,  in  character  format,  is  then 
compared  with  the  data  cards  to  determine  which  fields  are  being 
altered.   After  performing  the  alterations,  RLGCON  is  again  used 
to  return  to  Roadlog  file  format,  and  the  record  rewritten. 
The  PDRR  program  listing  follows: 
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/*  r'JPOATt,  FILE=ROADLOG,FUNCTIUN=REWRITE,DL)NAMC  =  XXXXX  */ 


1 
2 
3 
4 
5 
6 
7 
8 
9 
10 
11 
12 
13 
14 
15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 
39 
40 
41 
42 
43 
44 
45 
46 
47 
48 
49 
50 
51 
52 
53 
54 
55 
56 
57 
58 


/*  :(JPDATE,  F  I  LE  =  RGADLf)G  ,FUNCT  I  UN=REWR  I  Th" ,  DDNAME=XXXXX  */ 
REWRITE:  PROC(PARM)  OPT  IONS ( MA  IN ) ; 

/*  DECLARATION  FOR  INSTRUCTION  S  PRINT  ROUTINE  */ 
DECLARE 
PARM  CHAR( 100) , 
INSTR  CHAR (80)  FXT , 
#_HDGS  PIC'Z'  OFF  INSTR  P0S(72), 
COUNTY_#  PIC'ZZ1  DEF  CAR01  P0S(67), 
CITY_#  PIC'ZZZ'  OFF  CARD2  P0S(18), 
DDNAME  CHAR(8)  DEF  INSTR  POS(24), 
(PRINTER, HEADING(9) )  CHAR1132)  EXT, 
PRINTX  ENTRYtPIC'Z* ) ; 
/*  DECLARATION  FOR  DATA  INPUT  &  ROADLOG  FILE  */ 
DECLARE 
RECORD  CHAR( 120)  , 
RE(120)  CHAR(l)  DEF  RECORD, 
(CARD1,CARD2)  CHAR(80), 
CI  (80)  CHAR( 1)  DEF  CARD1, 
C2  (80)  CHAR(l)  DEF  CARD2, 
CARD  CHAR(8C)  BASED(PTR), 
C3(80)  CHAR(l)  BASED(PTR), 
C4  DEC  FIXED( 3,0) , 
NEWREC  CHAR( 132), 
NR(132)  CHAR(l)  DEF  NEWREC, 
DATA  FILE  RECORD  SFQL  INPUT, 

ROADLCG  FILE  RECORD  DIRECT  UPDATE  KEYED  ENV{ I NDF XED )  ; 
/*  OTHER  VARIABLES  */ 
DECLARE 
KEY  CHAR(  13)  , 
FLAG  BIN  FIXED; 
/*** INITIALIZATION***/ 
CALL  INIT(PARM) ; 
CALL  RLGCON; 
#_HOGS  =  2; 

HEADING(l)-'      ROADLOG—  FUNC T ION=RE WR I TE • ; 
OPEN 

FILE(DATA)TITLE(DDNAME), 
FILE  (ROADLOG); 
ON  KFY  (ROADLOG)BEGIN; 

PRINTER-1**  NO  RECORD  FOR  ATTEMPTED  REWRITE'; 
CALL  PRINTX(  1) ; 
GOTO  READ_DATA; 
END; 
ON  ENDFILE  (DATA)  GO  TO  FINISH; 
/*  EXECUTION  */ 
READ_DATA: 
READ  FILE  (DATA)  SET(PTR); 
PRINTERS   •  I  ICARO; 
CALL  PRINTX(2); 

IF  C3(l)=fl«  THEN  GOTO  CARD_1; 
IF  C3(l)=«2'  THEN  GOTO  CARD_2; 

PRINTERS**  INCORRFCT  CARD  CODE  IN  COLUMN  1«; 
CALL  PRINTX(2); 
GOTO  READ.DATA; 
CARD_l: 
IF  SUBSTR(CARD,9,1 )=• +•  THEN  DO; 
NEWREC='  • I ISUBSTR(CARD,2) ; 
KEY=SUBSTR(CARD,2,13); 
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/*  :UPDATE,  FILE=RnADLC)G,FUNCTlON=PEWRITF,DDNAME=XXXXX  */ 


59 

60 

61 

62 

63 

64 

65 

bt> 

67 

68 

69 

70 

71 

12 

73 

74 

75 

76 

77 

78 

79 

80 

81 

82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 

100 

101 

102 

103 

104 

105 

106 

107 

108 

109 

110 

111 

112 

113 

114 

115 

116 


END; 
ELSE  DO;  tr      .. 

NEWREC='  '  I  |SUBSTR(CARD,2,7)|  |'*0.'|  I  SUBSTRl  CARD  ,  9  ,  2  )  I  MOM  I 
SUBSTR(CARD, 11,66) ; 
KEY=SUBSTR(NEWREC,2,13) ; 
END; 
GOTO  CN2; 
CARD_2: 

IF  SUBSTR(CARD,9,1 )  =  • ♦•  THEN  DO; 
SUBSTR(NEWREC,81)=SUBSTR(CARD,15); 
SUBSTR (NEWR EC, 2, 1  3 )  =  SUBSTR ( CARD , 2 , 13) ; 
END; 
ELSE  DO; 
NEWREC=»  •  I  I  SUBSTR  (CARD,  2,  7)  ||'  +  .0'|  I  SUBSTR(  C  A«  D  ,  9  ,  2  >  IMOMM 
SUBSTR (NEWREC,8  1)=SUBSTR( CARD, 11) ; 

end; 

KEY= SUBSTR (NEWR EC, 2,  13)  ; 

CARD2=«  '  I  | SUBSTRl NEW REC, 2,  13)1  | SUBSTR (NEWR EC, 31 )  ; 
CN2: 

CAP  01='  M  I  KEY |  | SUBSTR (NEWR EC, 15,66) ; 
CARD2='  MlKEY||SUBSTR(NEWREC,Bl); 
IF  CH2hs'P  &  C  1(2  )-.=  »P«  &  Cim^'S'  THEN  DO; 

PRINTER=',***EPPOR  IN  ROUTE  SYSTEM  CODE  IN  FILE  RECORD  OR'  II 
•  IN  NEW  REWRITE  DATA***'; 
CALL  PRINTX(2); 
GOTO  READ.DATA; 
END; 
IF  C0UNTY_#>56  THEN  DO; 
PR INTER='***ERROR  IN  COUNTY  NUMBER  CODE  IN  NEW  REWRITE  DATA**'; 

CALL  PRINTXm  ; 
GOTO  READ_DATA; 
END; 

IF  CITY_#>126  THEN  DO; 
PR INTER=,***ERROR  IN  CITY  NUMBER  CODE  IN  NEW  REWRITE  DATA**'; 

CALL  PRINTX(2>; 
GOTO  READ_DATA; 
FND; 
READ  FILE(ROADLOG)  INTO ( R ECORD )  KEY ( SUBSTR ( NEwREC , 2 , 1 3 ) ) ; 
CALL  C0V2  (CARD1, CARD2, RECORD ) ; 
DO  1=50  TO  53,65  TO  132; 

IF  NR(  I  >-.=  '  '  THEN  DO; 
IF  NR(  I  )  =  '$'  THEN  NR(  I  >  =  •  •  ; 
IF  K81  THEN  Cl(  I ) =NR  (  I  ); 
ELSE  C2(  I-66)=NR( I) ; 
END; 
END; 
DO  1=3  TO  8,10,12  TO  14,50  TO  53,67  TO  72; 
IF(C1(  I  K'O'ICK  I  )>'9«  )&  CKI)-^1  •  THEN  GO  TO  ERR; 

[  NO; 

DO  1=15,17  TO  66; 
IF(C2(IX,0MC2(n>,9M6  C2(I)-^='  '  THEN  GOTO  ERR; 
END; 
DO  1=15  TU  49; 
IF  NR(l)-='  '  THEN  GOTO  CN4; 
END; 

II  j  CN3J 
CN4:  SUBSTR ( CAR Dl ,15,35 )*SUBSTR( NEWREC , 15, 35)  ; 
CN3:  DO  1=54  TO  64 ; 
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/* 

117 
118 
119 
120 
121 
122 
123 
124 
125 
126 
127 
128 
129 
130 
131 
132 
133 
134 
135 
136 
137 
138 


:UPDATE,     F  I  LE  =  R  0ADL0G,  FtJNCT  ION=REWR  ITE  ,  DDNAME=XXXXX    */ 

IF    NR(I)-='     •    THEN    GOTO    CN5; 
END; 

GOTO  CN6; 
CN5:  SUBSTRICARD1, 54, 11 )  =  SUBSTR ( NfcWREC , 54 ,  U)  ; 
CN6:  DO  1=15  TO  49,54  TO  64; 

IF  CI  (  I  )  =  • $•  THEN  01(1)='  '  ; 

end; 

CALL  C0V1 <CAR01,CARD2, RECORD); 
REWRITE  FILE(ROADLOG)FROM  (RFCORD)  KEY< SUBSTRC RECORD f2 )) 5 

GOTO  READ_DATA; 
ERR: 

PRINTER='**ERROR  IN  CODING  OF  NUMERIC  FIELDS,  RECORD  NOT  REWRITTEN'; 
CALL  PRINTXI2); 
GOTO  REAO_DATA; 
FINISH: 

PRINTERS     END  OF  DATA*  ; 

CALL  PRINTXI3); 

CLOSE 

E ILE(RGADL(G>, 
E ILE(DATA)  ; 
CALL  EXIT( PARM) ; 
END  REWRITE; 
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FUNCTrON=NEW-KEY : 

Member  Name PERN 

Language PL/ 1 

Subroutines  PRINTXl 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  UPDATE  messages 

ROADLOG   —  Road log  file 

any  name  —  Road log  data  cards 

Instruction 1  -  4  "PDRN" 

24  -  31  Name  of  input  DD  statement 

The  NEW-KEY  function  allows  alteration  of  the  key  field,  which 
cannot  be  performed  by  REWRITE.   Upon  reading  a  data  card  (con- 
taining the  existing  key  in  columns  1-13,  and  the  new  key  in 
columns  15-27) ,  the  program  first  checks  to  be  sure  that  no 
record  already  exists  with  the  new  key,  then  reads  the  existing 
record,  supplies  the  new  key,  inserts  the  record,  and  deletes 
the  old  record.   An  error  message  is  generated  either  if  a 
record  already  exists  with  the  new  key,  or  if  no  record  exists 
with  the  old  key. 

The  PDRN  program  listing  follows : 
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/*  :UPUATE,FlLE=FUAULOG,FUNCT  ION=N EW_K FY, ODNAME=XXX XX  */ 

l:  /*  :UPOATEtFILE=ROADLOGtFUNCTION=NEW_KEY,DDNAME=XXXXX  */ 

2:  NEWKEY:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 

3:  /*  INSTRUCTION  */ 

4:  DECLARE 

5:     INSTR  CHAR(80J  EXT, 

6:     DDNAME  CHARC8)  DEE  INSTR  POS(24J» 

7:     #_HDGS  PIC'Z'  DEF  INSTR  POS(72); 

8:  /*  PRINT  ROUTINE  */ 

9:  DECLARE 
10:     PARM  CHAR{  100)  , 

11:    (HEADING (9), PR  INTER)  CHAR (13?)  EXT, 
12:     PSINTX  ENTRY  (PTC'Z1  )  , 
13:     PklNTXA  ENTRY  ( P  I  C ' Z  ■  ,P  IC  ■  1 1  '  )  ; 

14:  /*  PERMANENT  FILE  */ 

15:  DFCLARE 

16:      RECORD  CHAR(1?0)  STATIC, 

17:        IP  DEE  RECORD, 

18 :        3   DUM1  CHAR( 1) , 

19:         3   KEY  CHAR(  13)  , 

20:  PERMOD  CHAR(8)  STATIC  INIT  ('ROADLOG'), 

21:     PFPM  FILE  RECORD  KFYED  ENV  (INDEXED); 

22:  /*  DATA  INPUT  */ 

23:  DECLARE 

24:     CAPO  CHAR(80)  BASFD  (PTR_DATA), 

25:     1   C  BASED  (PTR_DATA) , 

26:         3   OLD  CHAR (13), 

27:        3   DUM  CHAR( 1 ) , 

29:        3   NEW  CHAP (13), 

29:     DATA  FILE  RECORD; 


30:  /*****  INITIALIZATION  *****/ 

31 :  CALL  INIT  I PARM)  ; 

32:  »_HOGS  =  2; 

33:  HFAOING(i)  =  PFRMDD  I  I  'FILE  UPDATE  —  NEW  KEY'; 

34:  /*  INIT  FILES  */ 

35:  ON  UNOEFINEDFILE  (DATA)  BEGIN; 

36:         PRINTER  =  •***  '  ||  DDNAME  ||  «  DD  STATEHENT  MISSING1; 

37:        CALL  PR INTX  ( 31 ; 

3B:         GOTO  RETURN; 

39:        END; 

40:  OPEN  FILE  (DATA)  INPUT  RECORD  TITLE  ( JDNAMf  ) ; 

41:  OPEN  FILE  (PERM)  UPDATE  DIRECT  TITLE  (PERIOD); 

42:  ON  EMDFILE  (DATA)  GOTO  FINISH; 


43:  /*****  MAIN  EXECUTION  LOOP  *****/ 

44:  READ_DATA: 

45:     READ  FILE  (DATA)  SET  (PTR_DATA); 

46:     PRINTER  =  ■       'II  CARD; 
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/*     :UPOATF  fFlLE=ROADLOG,FLJNCTION=NEW_KFY,DDNAME=XXXXX    */ 


47: 
48: 
49: 
50: 
51  : 
52: 


CALL  PRINTXA  { 3,7) ; 

ON  KEY  (PERM)  GOTO  GET_RFCORD; 

READ  FILF(PERM)  I NTO ( R ECORD )  KEY(C.N 
PRINTER  =•***  ATTEMPT  TO  INSERT  OVER 
CALL  PRINTX  ( 1 ) ; 
GOTO  READ_DATA; 


EXISTING  RECORD1 


: 
: 


r 


53 
54 
55 
56 
57 
58 
59 
63 
61 
62 
63 


GFT_RECORD: 

ON  KEY  (PERM)  HEGIN; 

PRINTER  =  '***  RECORD  DOES  NOT  EXIST  IN  FILE'; 
CALL  PRINTX  ( 1) ; 
GOTO  pead_data; 

END; 
READ    FILE(PERM)     INTO(PECORD)     KEYIC.OLD); 

.<.KEY  =  C.NEW; 

WRITE  FILE  (PERM)  FROM  (RECORD)  KFYFROM  (R.KtY); 

OFLFTE  FILE  (PERM)  KEY  (COLO); 

GOTO  READ.OATA; 


64:  FINISH: 

65:      PRINTER  =  ■   ENO  OF  DATA* 

66:     CALL  PRINTX  (3); 

67:     CLOSE  FILE  (PERM); 

68:     CLOSE  FILE  (DATA); 

69:  RETURN: 

70:     CALL  EXIT  (PARM) ; 

71:  FND  NFWKFY; 
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COPY  — 


Member  Name PBR 

Language PL/ 1 

Subroutines  PRINTX1 

RLGCON 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  COPY  printer  output 
ROADLOG  —  Road log  file 
SAVERLG  —  Backup  copy  (output) 

Instruction 1  -   3   "PBR" 

5   "y"/"N"  for  LIST=YES/LIST=NO 


COPY  prepares  a  backup  copy  of  the  Roadlog  file.   The  backup  copy  is  a  sequen- 
tial version  of  the  Roadlog  file,  with  identical  record  length  (120  characters) 
A  dummy  record  containing  the  date  is  first  written.   This  record  is  followed 
by  the  Roadlog  records.   If  LIST=YES  is  specified,  RLGCON  is  used  to  convert 
the  Roadlog  records  into  character  format,  and  the  records  are  listed  in  the 
same  "dump"  format  as  when  DUMP  is  used  to  list  the  file.   A  count  is  taken 
of  the  number  of  records  in  the  file.   The  count  is  printed  after  the  last 
record  is  written. 

The  PBR  program  listing  follows : 


-81- 


/*  :CGPY,FI LE=ROADLOG,LIST=YFS/NO  */' 

1:  /*  :C0PY,FILE=ROAOL0G,LIST=YES/N0  */ 

2:  COPY:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 

3:  /*  INSTRUCTION  */ 

4*.  DECLARE 

5:     INSTR  CHAR (80)  EXT, 

6:     LIST  CHAR(l)  DEF  INSTR  P0S(5), 

7:      #_HDGS  PIC'Z'  OFF  INSTR  POS(72);   . 

8:  /*  PRINT  ROUTINE  */ 

9:  OECLAKF 
10:     PARM  CHAR( 100) , 

11:  (  HEADING(9)  tPRINTF.P  )     CHAPI132)     EXT, 

12:  PRINTX    ENTRY     (PIC'Z* > ; 

13:  /*  FILES  */ 

14:  DECLARE 

15:  (CARDUCARD2)     CHAR(80), 

16:  RECORD    CHAR ( 120)     BASED(PTP), 

17:     QACKDD  CHAR (8)  STATIC  IN  IT  (  ■ SA VERLG ■  ) , 

18:     PERMDD  GHAR(8)  STATIC  INIT  (•ROADLOGM, 

19:     PERM  FILF  RECORD  KEYED  ENV  (INDEXED), 

20:     BACKUP  FILE  RECORD; 

21:  /*  OTHER  VARIABLES  */ 

22:  DECLARE 

23:     UD  CHAR(6) , 

24:     CNTR  BIN  FIXED  ( 31) , 

25:     PCNTR  P I C • I ZZZZ9 • ; 


26:  /*****  INITIALIZATION  *****/ 

27:  CALL  INIT  (PARM) ; 

28:  /*  SET  UP  HEADINGS  */ 

29:  ¥_HDGS  =  2; 

30:  HEADING* 1)  =  PERMDD  ||  'FILE  COPY  ROUTINE1; 

31:  /*  INIT  FILES  */ 

32:  OPEN  FILF  (PERM)  INPUT  TITLE  (PERMDD); 

33:  OPEN  FILE  (BACKU?)  OUTPUT  TITLL  (3ACKDD); 

34:  UN  ENDFILF  (PERM)  GOTU  DONE; 

35:  /*  RECORD  DATE  */ 

36:  UD  =  DATE; 

37:  PTR  =  ADDK(HFADING(9)  ); 

38:  RECORD  =  SUBS TR ( UD , 3, 2 )  II  »/■  || 

39:  SUBSTR(UD,5,2)  II  •/•   II  SUBS Tk ( UD, L , 2 ) ; 

40:  WRITE  FILE  (BACKUP)  FRUM  (RECORD); 


4! :  /*****  maiN  EXECUTION  LOOP  *****/ 

42:  DO    CNT<3  =  1     TO    999999; 

43:  READ    FILF     (PERM)     SFT     (PTR); 

44:  WRITF     FILE     (BACKUP)     FROM     (RECOkO); 
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/*  :COPY,FILE=ROADLOG,L1ST=YES/N0  */ 

45:  IF  LIST=«Y«  THEN  DO; 

46:  PRINTER=SUBSTR(CARD1,2 ) I  I SUR STR ( C ARD2 , 15) 

47:  PRINTER=CARD1| I SU3STR (C ARD2 , 15) ; 

43:  CALL  PRINTX  (1); 

49:  END; 

50:  END; 


51:  DONE: 

52:  PCNTR  =  CNTR  -  1; 

53:  PRINTER  =  'NUMBER  OF  RECORDS  IN  FILE 

54:  CALL  PRINTX  ( 3) ; 

55:  CLOSE  FILE  (PERM); 

56:  CLOSE  FILE  (BACKUP) ; 

57:  CALL  EXIT  (PARM); 


I  I  PCNTR  ; 


58:  END  COPY; 
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CREATE  — 


Member  Name PAR 

Language PL/ 1 

Subroutines  PRINTX1 

RLGCON 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  CREATE  output 
ROADLOG  —  Roadlog  file  (output) 
SAVERLG  —  Backup  copy 

Instruction 1-3   "PAR" 

5    "Y"/"N"  for  LIST=YES/LIST=NO 


CREATE  restores  the  Roadlog  file  from  a  backup  copy  saved  via  program  COPY. 
The  first  record  in  the  file  is  a  dummy  record,  containing  the  date  on  which 
the  file  was  copied.   This  date  is  printed  prior  to  performing  the  create 
operation.   After  printing  the  date,  the  records  are  read  from  the  backup 
copy  and  written  into  the  Roadlog  file,  destroying  the  previous  file.   If 
LIST=YES  is  specified,  subroutine  RLGCON  is  used  to  convert  the  records  to 
character  format  for  printing.   As  with  COPY,  the  records  are  counted  as  they 
are  written.   The  count  is  printed  after  the  create  operation  is  complete. 
The  PAR  program  listing  follows: 
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/*  :CREATE,FILE=ROADLOG,LlST=YES/NO  */ 

l:  /*  .'CREATE, FlLE=ROAOLOG,LIST  =  YES/NO  */ 

?:    CREATE:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 

3:  /*  INSTRUCTION  */ 

4:  DECLARE 

5:     INSTR  CHAR(80)  EXT, 

6:     LIST  CHAR(l)  OEF  INSTR  POS(5), 

7:     #_HDGS  PIC'Z'  OFF  INSTR  POS(72); 

3:  /*  PRINT  ROUTINE  */ 

9:  DECLARE 
10:     PARM  CHAR( ICO) , 

11:    (HEADING<9) , PRINTER)  CHAR<132)  EXT, 
12:     PRINTX  ENTRY  (PIC'Z1 ) ; 

13:  /*  FILES  */ 

14:  DECLARE 

15:     (CAR01,CARD2)CHAR(80) , 

16:     RECORD  CHAR(120)  BASED(PTR), 

17:     BACKDD  CHAR(8)  STATIC  INIT  ('SAVERLG1),   • 

13:     PFRMOD  CHAR(8)  STATIC  INIT  ( • ROADLOG • ) , 

19:     PERM  FILE  RECORD  KEYED  ENV  (INDEXED), 

20:     BACKUP  FILE  RECORD; 

21:  /*  OTHER  VARIABLES  */ 

22:  DECLARE 

23:     CNTR  BIN  FIXED  (  31)  , 
24:     PCNTR  PIC  ZZZZ79'  ; 

?5:  /*****  INITIALIZATION  *****/ 

26:     CALL  INIT  (PARM); 

27:     /*  SET  UP  HEADINGS  */ 

28:     #_HDGS  =  2; 

29:     HEADING(l)  =  PERMDD  I  I  'FILF  CREATION  ROUTINE1; 

30:  /*  INIT  FILFS  */ 

31:  OPFN  FILE  (BACKUP)  INPUT  TITLE  (8ACKDDM 

32:  OPEN  FILE  (PERM)  OUTPUT  TITLE  (PERMDD); 

33:  UN  ENOFILE  (BACKUP)  GOTO  DONE; 

34:  /*  PRINT  DATE  */ 

35:  READ  FILE  (BACKUP)  SET  (PTR); 

36:  PRINTER  =  '    DATE  OF  BACKUP  FILE  IS  '  II  RECORD; 

37:  CALL  PRINTX  (1); 

33:  PRINTER  =  »  • J 

39:  CALL  PRINTX  (  1) ; 

40:  /*****  MAIN  EXECUTION  LOOP  *****/ 

41:  DO  CNTR=1  TO  999999; 

42:        READ  FILE  (BACKUP)  SET  (PTR); 

43:        WRITE  FILE  (PERM)  FROM  (RECORO)  KEYFROM  ( SUB STK ( RFCORO , 2 ) ) 

44:        IF  LIST='Y'  THEN  DO; 
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' 


/*  :CREATE,FILE=ROADLQG,LIST=YES/NO  */  * 

45:  CALL  C0V2 (CARD1 , CARD2, RECORD ) ; 

46:  PR  INTER=CARD1|  I  SUBSTR ( C ARD2 t  15);                                   [ 

47:  PRINTFR=SUBSTR(CARD1,2) I  I SUBSTRi C ARD2 , I  5 ) ; 

48:  END?                                                            r 

49:  END; 

50:  DONE: 

51 :  PCNTR  =  CNTR  -  1 ; 

52:  PRINTER  =  'NUMBER  OF  RECORDS  IN  FILE:   '  II  PCNTR;                . 

53:  CALL  PRINTX  (3); 

54:  CLOSE  FILE  (PERM);                                                   r 

55:  CLOSE  FILE  (BACKUP)  *, 

56:  CALL  EXIT  (PARM); 

57:  END  CREATE; 
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LIST-&-SUM  — 

Member  Name NAR 

Language PL/I 

Subroutines  PRINTXl 

Files SYSPRINT  —  IBM  messages 

PRINTER  ~  LIST-&-SUM  output 

ROADLOG   —  Roadlog  file 

CNTYTBL  —  Table  of  county  names 

Instruction 1  -   3   "NAR" 

40  -  43  Beginning  route  number 
56  -  59   Ending  route  number 

LIST-&-SUM  provides  the  main  listing  of  Roadlog  data  that  forms  the  bulk  of 
the  annual  Roadlog  report.   It  always  operates  on  entire  routes;  if  the  user 
specifies  a  portion  of  a  route  on  his  command,  the  entire  route  is  processed. 
For  each  route  processed  in  a  run,  two  steps  are  performed.   The  first  step 
is  to  read  the  records  for  the  route,  list  the  records  in  the  proper  format, 
and  save  the  mileages  in  arrays  for  printing  by  county  and  by  location  code. 
The  second  step,  performed  after  the  "EN"  record  indicating  the  end  of  the 
route  has  been  printed,  is  to  print  the  county  summary.   LIST-&-SUM  processes 
only  those  Roadlog  records  with  remark  codes  "  ,"  "SP,"  "LP,"  "OS,"  "NE," 
"DS,"  "ER,"  "EN,"  and  "CO."  All  other  records  are  by -passed.   "DS"  records 
are  descriptive  records.   The  description  field  is  printed,  centered  on  the 
page.   A  blank  line  precedes  and  follows  the  description.   This  record  type 
is  used  for  indicating  signed  route  numbers  and  the  beginnings  of  spurs  and 
loops.   "ER"  records,  like  "DS"  records,  contain  only  a  description.   "ER" 
description,  however,  are  not  centered  and  are  not  set  off  with  blank  lines. 
"EN"  records  indicate  the  ends  of  routes.   Each  time  an  "EN"  record  is 
encountered,  the  following  tasks  are  performed:   1)  the  "EN"  description  and 
milepoint  are  printed,  2)  the  county  summary  is  printed,  and  3)  variables  are 
re- initialized  for  processing  the  next  route.   "CO"  records  indicate  coincident 
sections.   When  one  of  these  is  encountered,  the  milepoint  and  description 
fields  are  printed.   The  starting  and  ending  keys  of  the  coincident  section 
are  retrieved  from  the  description,  and  the  coincident  section  scanned.   The 
section  lengths  in  the  coincident  section  are  added  to  the  accumulated  length, 
which  is  then  printed  on  the  same  line  as  the  description  and  milepoint.   The 
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coincident  mileage  is  not  included  in  the  county  summary.   The  other  five 
record  types  are  "mileage"  records.   When  a  mileage  record  is  read,  it  is 
first  formatted  for  printing  and  printed.   The  mileage  is  then  stored  in  an 
array  for  future  use.   The  summary  by  counties  shows  the  mileage  broken  down 
by  the  56  counties,  and  by  location.   The  nine  location  breakdowns  are: 
route  length,  constructed  length,  unimproved  length,  wye  length,  municipal, 
county,  national  forest,  Indian  reservation,  and  other.   Three  further 
classifications  are  made:   spurs,  loops,  and  all  others.   The  spurs  and 
loops  are  shown  separately.   Setting  up  a  directly -addressed  array  for  the 
summary  would  require  a  56x9x3  array  of  decimal  (7,3)  variables,  or  6048 
bytes  of  storage.   In  order  to  allow  operation  in  a  small  partition,  an 
indirect-addressing  technique  is  used  in  the  program.   The  indirect  method 
reduces  the  amount  of  core  required  to  25x9  decimal  variables,  or  900  bytes 
(plus  a  small  amount  of  overhead  core).   MBC  is  an  array  of  25  structures, 
each  having  9  decimal  variables  for  the  storage  of  one  county.   ACNTY  is 
a  56x3  array  of  binary  variables,  which  performs  the  addressing  into  MBC. 
At  the  beginning  of  each  route,  both  MBC  and  ACNTY  are  set  to  zero.   An 
additional  variable,  #_C0UNTIES,  keeps  track  of  the  number  of  elements  of 
MBC  utilized  (also  initialized  to  zero) .   The  first  record  of  a  route  is 
never  a  spur  or  loop.   The  second  element  of  ACNTY  has  a  value  of  2  for  "SP" 
(spur)  records,  3  for  "LP"  (loop)  records,  and  1  for  all  other  mileage  records. 
Hence,  this  will  have  a  value  of  1  for  the  first  mileage  record.   The  first 
subscript  of  ACNTY  is  the  county  number.   The  county  number  in  the  Roadlog 
record  is  retrieved,  and  use  to  access  ACNTY.   The  element  of  ACNTY,  found 
to  be  zero,  is  set  to  1  (indicating  that  the  first  structure  of  MBC  will  be 
used),  and  #_C0UNTIES  is  incremented.   Whenever  a  succeeding  record  contains 
the  same  county  number,  and  falls  into  the  same  spur /loop/other  category, 
the  program  will  find  that  the  element  of  ACNTY  accessed  is  already  non-zero, 
and  will  use  the  structure  of  MBC  pointed  to  by  the  ACNTY  element.   Whenever 
the  element  of  ACNTY  accessed  is  zero,  another  structure  of  MBC  is  allocated, 
//_C0UNTIES  incremented,  and  the  element  of  ACNTY  altered  to  indicate  the  number 
of  the  structure  used.   MBC  presently  is  allocated  25  structures,  which  is  well 
more  than  required  for  any  present  routes.   If,  during  the  processing  of  a 
route,  a  26th  structure  is  required,  the  program  will  print  the  message: 

***  INSUFFICIENT  STORAGE  FOR  COUNTY  SUMMARY 
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Should  this  occur,  MBC  must  be  allocated  more  structures,  and  the  test  (in 
the  SAVE_MILEAGES  portion  of  the  program)  for  MBC  overflow  altered  to  indicate 
the  new  size. 

The  NAR  program  listing  follows: 
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/*  :LIST_£_SUM,REPORT=ROADLOG,DATA=XXXXX  */ 

l:  /*  :LIST_&_SUM,REPORT=ROADLOG,DATA=XXXXX  */ 

2:  LISTSUM:   PROCEDURE  (PARM)  OPTIONS  (MAIN);  [ 

3:  /*****  DECLARATION  OF  VARIABLES  (ALPHABETICAL  ORDER)  *****/ 


4 
5 
6 
7 
8 
9 
10 
11 
12 
13 
14 
15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 
39 
40 
41 
42 
43 
44 
45 
46 
47 
48 
49 
50 
51 
52 
53 
54 


DECLARE 

#_COUNTIES  DEC  FIXED  (3,0)  STATIC, 

#_HDGS  PIC'Z'  DEF  INSTR  P0S(72), 

#_LINES  PIC'ZZ'  STATIC, 

ACCUM_MILEAGE  DEC  FIXED  (7,3)  STATIC,  r 

ACNTY(56,3)  BIN  FIXED  STATIC, 

C2  CHAR(2),  k 

C0DE(3)  CHAR(7)  INIT(«  ','  (SPUR)',1  (LOOP)'), 

C0UNTY(56)  CHAR(15)  STATIC, 

DFRLG  CHARU32)  STATIC,  1 

DUPLICATE  DEC  FIXED  (5,3)  STATIC, 

ENDKEY  CHAR(4)  DEF  INSTR  P0S(56), 

F(0:9)  PIC'Z'  STATIC  INIT  (0,1,2,3,4,5,6,7,8,9), 

I       FRLG    DEF     DFRLG, 

3       DESCR    CHAR(35),  . 

3       MP, 

5       MILEPOST    PICZZZZ9',  « 

5       OFFSET    CHAR(7), 

3       MAINT_SEC    PIC'ZZZZB', 

3       PROJ_CLASS    CHAR(12), 

3      YR_BLT    PIC'ZZBB', 

3       YR_IMP    PIC'ZZBBB',  r 

3       SURTYP    CHAR(4), 

3   SURF_THICKNESS  PIC'ZZZV.Z', 

3   BASE_THICKNESS  PIC'ZZZV.Z', 

3   SURF_WIOTH  910*17.71*  , 

3       RDWAY_WIDTH    PIC'ZZZZZ', 

3       #_LANES    PIC'ZZZ', 

3   SECTN  PIC'ZZZZV.ZZZBB' ,  [ 

3   LOCATION  CHAR(6), 

3   CONST  PIC'ZZZZV.ZZZ', 

3   ACCUM_MLGE  P I C1 ZZZZZV . ZZZ • ,  . 

HEA0ING(9)  CHAR(13?)  EXT, 

INIT_FLAG  CHAR(l),  * 

INSTR  CHAR(80)  EXT, 
(KEY1,KEY2)  CHAR( 16) , 
LOC2(0:10)  CHAR(6)  STATIC  INIT  1 

(i******«,i  CITY  ', 'COUNTY* , 'NATFOR' ,' INDRES' , •  GAME  », 

•MILRES',  'NATMON'  ,  'NATPRK'  ,  'ST  FOR', 'ST  PRK'),  i 

LINES  CHAR(132)  STATIC  INIT  ((132)'-'), 
1   MBC(25)  LIKE  MLGE  STATIC, 
1   ML  STATIC, 

3   ROUTE  PIC'ZZZV.ZZZ', 

3   CONST  PIC'ZZZZV.ZZZ',  l 

3   UNIMP  PIC'ZZZZV.ZZZ', 

3   WYE  PIC'ZZV.ZZZ  '  ,  I 

3   CITY  PIC'ZZZZV.ZZZ',  I 

3   CNTY  PIC'ZZZZV.ZZZ', 

3   NFOR  PIC'ZZZZV.ZZZ', 

3   IRES  PIC'ZZZZV.ZZZ', 

3   OTHR  PIC'ZZZV.ZZZ' ,  l 
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/*  :LIST_6_SUM,REP0RT=R0ADL0G,DATA=XXXXX  */ 


55 
56 
57 
58 
59. 
60 
61 
62 
63 
64 
65 
66 
67 
68 
69 
70 
71 
72 
73 
74 
75 
76 
77 
78 
79 
80 
81 
82 
83 
84 
85 
86 
87 
88 
89 
90 
91 
92 
93 
94 
95 
96 
97 
98 
99 
100 
101 
102 
103 
104 
105 


1   MLGE  STATIC, 

3  (ROUTE,CONST,UNIMP,WYE,CITY,CNTY,NFOR, IRES,OTHR) 
DEC  FIXED  (7,3), 
OUT_OF_STATE  LIKE  MLGE, 

PAGE_P0SITI0N  PIC»ZZ'  DEF  INSTR  P0S(9), 
PAGE_SIZE  PIC'ZZ*  DEF  INSTR  POS(7), 
RECORD  C>.«k(80)  BASED  (PTR_TBL>, 
PARM  CHAR(IOO) , 

PRINTER  CHARI132)  EXT,   /**  DATA  FOR  PRINTING  **/ 
1   RLG  BASED  (PTR_RLG), 
3   DUMMY1  CHAR(l), 
3   KEY, 

5   SYSTEM  CHAR(  1), 
5   RT_#  PIC,999«, 
5   MP, 

7   MILEPOST  PIC'ZZZ' , 
7  OFFSET  CHAR(6), 
3   REMARK  CHAP(2), 

3   (SECTN, ROUTE, CONST, UNIMP)  DEC  FIXED(5,3), 
3   WYE  DEC  FIXED(3,3), 
3   DESCR  CHAR(35) , 
3   PROJ_CLASS  CHAR(ll) , 
3   DIVIDED.CODE  CHAR(l), 

3   (#_LANES,POPULATION_CODE)DEC  FIXED(1,0), 
3   (CITY_#,COUNTY_#,YR_BLT,YR_IMP,FORHWY_#,ADMIN_CODE, 

L0CNI2) ,DUMM,SURF_WIDTH,RDWAY_WIDTH)DEC  FIXED(3,0), 
3   (SURF_THICKNESS,BASE__THICKNESS)DEC  FIXED(3,1), 
3   SURF_TYPE_CODE  DEC  FIXED! 1,0), 
3   (SURF_TYPE,MAINT_SEC)  DEC  FIXED(5,0), 
3   DATE, 

4  (MONTH, DAY, YEAR)  DEC  FIXED(3,0), 
3  DUMMY2  CHAR(2)  , 
1   RLG2  BASED  (PTR_RLG), 
3   DUM  CHAR(l) , 
3   KEY  CHAR(13), 

3  DUMM1  CHAR (16) , 
3   CN, 

5   DUM1  CHAR(5)  , 
5   RT_#  CHARI4) , 
5   DUM2  CHAR (6), 
5   KEY(2i  CHAR(IO), 
ROADLOG  FILE  INT  RECORD  KEYED  ENV  (INDEXED  GENKEY) , 
RURAL_MILEAGE  P IC • ZZZZZV. ZZZ • , 
SAVE_KEY  CHAR (16), 

STARTKEY  CHARJ4)  DEF  INSTR  P0S(40), 
STRING_ML  CHAR(68)  DEF  ML, 
SURF(0:8)  CHAR(3)  STATIC  INIT 

(  •  • , «PRM« , »BLD» ,'GRD' ,  'GRV1, »BST 
TOT_CONST  PIC'ZZZZV.ZZZ' , 
1   TOTALS  LIKE  MLGE  STATIC, 
ZRT  *  PIC'ZZZ'; 


106:  /*****  PROGRAM  INITIALIZATION  *****/ 

107:     /***  INIT  PERFORMS  PRINT  ROUTINE  INITIALIZATION  ***/ 
108:     CALL  INIT  (PARM); 
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/*  :LIST_&_SUM,REPORT=ROADLOG,DATA=XXXXX  */ 


117 

118 
119 
120 
121 
122 
123 
124 
125 
126 
127 
128 


I 
[ 

[ 


109:  /**  SET  UP  COLUMN  HEADINGS  **/ 

110:  #_HOGS  =  5; 

111:  HEADINGO)  =  •  SECTION                      MILE    ■  II 

112:        <  MTCE  PROJECT  YEAR    SURE   THICKNESS    WIDTH    NO  •  I  I 

113:        ■   SECT    LOCA-  PROJCT    ACCOM'; 

114:  HEADINGS)  =  •  DESCRIPTION                   POST    »  II 

115:         •  SECT  NUMBER  BLT  IMP   TYPE   SURE  BASE   SURE  RDY  LN  •  I  I 

116:        •  LENGTH   TION  LENGTH   MILEAGE1; 

/**  READ  TABLE  OF  COUNTY  NAMES  **/ 

OPEN  EILE  (TABLE)  INPUT  RECORD  TITLE  ('CNTYTBLM;  r 

DO  Jl=l  TO  56;  I 

READ  FILE  (TABLE)  SET  ( PTR_TBL ) ; 

COUNTY(Jl)    =    RECORD;  r 

END; 


CLOSE    FILE     (TABLE) ; 

OPEN  FILE  (ROADLOG)  INPUT  SEQL; 


ON  ENDFILE  (ROADLOG)  GO  TO  RETURN;  |~ 

READ  FILE  (ROADLOG)  SET  (PTR_RLG)  KEY  (STARTKEY);  I 

INIT_FLAG  =  •!•; 
J.CARRIAGE  =  l; 


129:  /*****  MAIN  CONTROL  LOOP  *****/ 

130:     /**  INIT_FLAG  IS  SET  WHENEVER  A  ROUTE  IS  FINISHED,  AND  ITS  COUNTY 
131:         SUMMARY  PRODUCEO  **/ 

132:  LOOP: 

133:     IF  INIT_FLAG=' P  THEN  GOTO  VAR I ABL E_IN I T I AL I Z ER ; 

134:  L05: 

135:     IF  RLG.REMARK=»   •  |  RLG.REMARK= • ER«  I  RLG. REMARK= • EN •  | 

136:        RLG.REMARK='DS«  |  RLG.R EMARK^ •CO •  I  RLG. PEMARK= • OS •  I 

137:        RLG.REMARK=,NE«  I  RLG.R EMARK= • SP*  I  R LG. REMARK= • L P • 

138:        THEN  GOTO  PRI NT_RECORD; 

139:  READ_NEXT_RECOPD: 

140:     READ  FILE  (ROADLOG)  SET  (PTR_RLG); 

141:     GOTO  LOOP; 

142:  RETURN: 

143:     CLOSE  FILE  (ROADLOG); 
144:     CLOSE  FILE  (TABLE); 
145:     CALL  EXIT  (PARM) ; 
146:     RETURN; 

147:  /*****  SUBROUTINE  TO  INITIALIZE  VARIABLE  AT  THE  BEGINNING  OF  ROUTE 

148:  VARIABLE_INITIALIZER: 
149:     INIT_FLAG  =  •  • ; 
150:     #_COUNTIES  =  0; 
151  :     ACCUM_MILEAGE  =  0; 
152:     ACNTY  =  0; 
153:     DUPLICATE  =  0; 
154:     MBC  ■  0; 
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/*  :LIST_£_SUM,REPORT=ROADLOG,DATA=XXXXX  */ 


155 
156 
157 
158 
159 
160 
161 
162 
163 
164 
165 
166 
167 
168 
169 
170 
171 
172 


174 
175 
176 
177 
178 
179 
180 
181 
182 
183 
184 
185 
186 
187 
188 
189 
190 
191 
192 
193 
194 
195 
196 
197 

198 
199 
200 
201 
202 
203 
204 
205 
206 
207 
208 


OUT_OF_STATE  =  0; 

TOT_CONST  =  0; 

TOTALS  =  0; 

ZRT_#  =  RLG.RT_#; 

IF  RLG.SYSTEM=' I •  THEN  SUBSTR(HEAO ING ( 1 ) t 46,45 )  = 

•FEDERAL  AID  INTERSTATE  ROUTE  NUMBER*  II  ZRT_#; 
ELSE  IF  RLG.SYSTEM=»P«  THEN  SUBSTR ( HEADING* 1 ), 46, 45)  = 

•FEDERAL  AID  PRIMARY  ROUTE  NUMBER1  II  ZRT_#; 
ELSE  SUBSTR(HEADING( 1 ),46,45)  = 

•FEDERAL  AID  SECONDARY  ROUTE  NUMBER  •  II  ZRT_#; 

Jl  =  5; 

IF    PAGE_POSITION+20>PAGE_SIZE    THEN    PAGE_POSI TION    =    PAGE_SIZE; 
ELSE    DO    J2=l    TO    #_HDGS; 

PRINTER    =    HEADINGU2); 

CALL    PRINTX     (F( Jl) ); 

Jl    =    l; 

END; 
GOTO    L05; 


173:     /*****    SUBROUTINE    TO    FORMAT    ROADLOG    RECORDS    AND    PRINT    THEM    *****/ 


PRINT_RECORD: 

IF    RLG.REMARK=«DSI     THEN    DO; 

PRINTER    =    •     ' ; 

SUBSTR(PRINTER,60,35)  =  RLG.DESCR; 

#_LINES  =  e; 

CALL  PRINTXA  ( F ( 2 > ,#_L INES ) ; 

J_CARRIAGE  =  2; 

GOTO  READ_NEXT_RECORD; 

END; 
DFRLG  =  •  • ; 
IF  RLG.REMARK='ER»  I  RLG.REMARK=* EN»  I  RLG.REMARK= »C0» 

THEN  DO; 

FRLG.DESCR  =  RLG.DESCR; 

IF  RLG. REMARK -.=  'ER  '  THEN  DO; 

FRLG.MILEPOST  =  RLG. MILEPOST ; 
FRLG. OFFSET  =  RLG. OFFSET; 

END; 

PRINTER  =  DFRLG; 

CALL    PRINTX    ( F( J_CARR IAGE ) ) ; 

J_CARRIAGE    =    1; 

IF  RLG.REMARK=»CO»  THEN  GOTO  CO_PROCESSOR ; 

IF  RLG.REMARK='EN'  THEN  GOTO  SUMM ARY_BY_COUNTIE S; 

GOTO  READ_NEXT_RECORD; 

END; 

NO_REMARK: 

FRLG  =  RLG,  BY  NAME; 

FRLG.MILEPOST  =  RLG.M ILEPOST ; 

FRLG. OFFSET  =  RLG. OFFSET; 

ACCUM_MILEAGE  =  ACCUM_M ILE AGE  +  RLG.SECTN; 

FRLG.ACCUM_MLGE  =  ACCUM_MIL EAGE ; 

FRLG.SURTYP  =  SURF (RLG. SURF_TYPE_CODE ) ; 

IF  SUBSTR (FRLG. PRO J_C LASS, 1,3)=«MC» 

THEN  FRLG.PROJ_CLASS  =  'CITY  CONSTR»; 
ELSE  IF  SUBSTR(FRLG.PR0J_CLASS,1,3)='CC«  THEN 

FRLG.PROJ_CLASS  =  'CNTY  CONSTR*; 
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/*    :LIST_6_SUMtREP0RT=ROADL0G, DATA=XXXXX    */ 

u 

209:  IF    RLG.P0PULATI0N_C0DE>3    I    RLG.L0CN( I ) =2 

210:  THEN    FRLG. LOCATION    =    'URBAN' ; 

211:  ELSE    FRLG. LOCATION    =    L0C2< RLG.LOCN ( 1 )) ; 

212:  PRINTER    =    DFRLG; 

213:  CALL    PRINTX     <F ( J_C ARR  I  AGE ) ) ; 

214:  J.CARRIAGE    =    1; 

215:  /**  CHECK  FOR  DUPLICATE  MILEAGES  **/ 

216:  IF  RLG.LOCN(2)=0  THEN  GOTO  SAVE_MILEAGES; 

217:  DFRLG  =  •  • ; 

218:  FRLG. LOCATION  =  LOC 2 ( RLG.LOCN( 2 ) ) ; 

219:  PRINTER  =  DFRLG; 

220:  CALL  PRINTX  <F(l)>; 

221:  GOTO  SAVE_MIL EAGES ; 

222:  /*****  SUBROUTINE  TO  ACCUMULATE  MILEAGES  FOR  COUNTY  SUMMARY  *****/ 


223 
224 
225 
226 
227 
228 
229 
230 
231 
232 
233 
234 
235 
236 
237 

238 
239 
240 
241 
242 
243 
244 
245 
246 
247 
248 
249 
250 
251 
252 
253 
254 
255 
256 
257 
258 
2  59 
260 
261 


SAVE_MILEAGES: 
MLGE  =  0; 

MLGE. ROUTE  =  RLG. ROUTE; 

MLGE. CONST  =  RLG.SECTN  -  RLG. WYE  -  RLG.UNIMP; 
MLGE.UNIMP  =  RLG.UNIMP; 
MLGE. WYE  =  RLG. WYE; 
DO  Ji=l  TO  2; 

IF  RLG.LOCN! Jl)=l  THEN  MLGE.C ITY=RLG. SECTN; 

ELSE  IF  RLG.LOCN* Jl)=2  THEN  MLGE .CNTY=RLG. SECTN; 

ELSE  IF  RLG.LOCN( Jl)=3  THEN  MLGE .NFOR=RLG. SECTN; 

ELSE  IF  RLG.LOCN! Jl)=4  THEN  MLGE . IRES=RLG. SECTN; 

ELSE  IF  RLG.LOCN<  Jl)-*=0  THEN  MLGE  .OTHR=RLG.  SECTN; 
END; 
IF  RLG.LOCN! 2 )-=0  THEN  DUPL ICATE=DUPL ICATE+RLG. SECTN; 
TOT_CONST  =  TOT_CONST  ♦  RLG. CONST; 

/**  STORE  THE  MILEAGES  BY  COUNTY  **/ 
IF  RLG.REMARK=»OS»  THEN  DO; 

OUT_OF_STATE  =  OUT_OF_STATE  ♦  MLGE; 

GOTO    READ_NEXT_RECORD; 

END; 
Jl  =  RLG.COUNTY_*; 
IF  J1=0  I  Jl>56  THEN  DO; 

CALL  ASTER; 

PRINTER  =  •***  INVALID  COUNTY  NUMBER  IN  ABOVE  RECORD'; 

CALL  PRINTX  (F(2) )  ; 

CALL  ASTER; 

GOTO  READ_NEXT_RECORD; 

END; 
IF  RLG.REMARK='SP'  THEN  J2  =  2; 

ELSE  IF  RLG.REMARK='LP'  THEN  J2  =  3; 

ELSE  J2  =  l; 
IF  ACNTY( J1,J2)=0  THEN  DO; 

#_COUNTIES  =  #_COUNTIES  *  1; 

IF  #_C0UNTIES>25  THEN  DO; 

PRINTER  =  •***  INSUFFICIENT  STORAGE  FOR  COUNTY  SUMMARY' 
CALL  PRINTX  ( F ( 2) I ; 
GOTO  RETURN; 

end; 

ACNTY<J1,J2I     ■    #_COUNTIFS; 
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/*  :LIST_&_SUM,REPORT=ROADLOG,DATA=XXXXX  */ 

262:        FND; 

263:  Jl  =  ACNTY( Jl, J2 ); 

264:  MBC(Jl)  =  MBC(Jl)  +  MLGE; 

265:  GOTO  READ_NEXT_RECORD ; 


266:  /*****  SUBROUTINE  TO  PROCESS  COINCIDENT  SECTIONS  *****/ 


267 
268 
269 
2  70 
271 
272 
273 
2  74 
275 
276 
277 
278 
279 
280 
281 
282 


292 
293 
294 
295 
296 
297 
298 
299 
300 
301 
302 
303 
304 
305 
306 
307 
308 
309 
310 
311 
312 


CO_PROCESSOR: 

SAVE_KEY  =  RLG2.KEY; 

KEY1  =  RLG2.CN. RT_#  ||  RLG2. CN.KEY ( 1 ) ; 
KEY2  =  RLG2.CN. RT_#  ||  RLG2 .CN.KEY ( 2 ) ; 
ON  KEY  (ROADLOG)  BEGIN; 

CALL  ASTER; 

PRINTER  =  •***  NO  RECORD  FOR  STARTKEY  SPECIFIED1; 

CALL  PRINTX  (F(2) ) ; 

call  aster; 

go  to  back; 

end; 
read  file  (roadlog)  set  (ptr_rlg)  key  (key1); 
do  while  (rlg2.key<key2); 

accum_mileage  =  accum_mileage  +  rlg.sectn; 

read  file  (roadlog)  set  (ptr_rlgi; 

END; 


283:  BACK: 

284:  DFRLG  =  '  • ; 

285:  FPLG.ACCUM_MLGE  =  ACCUM_MILEAGE; 

286:  PRINTER  =  DFRLG; 

287:  CALL  PRINTX  (F(0)); 

288:  J.CARRIAGE  =  1; 

289:  READ  FILE  (ROADLOG)  SET  <PTR_RLG)  KEY  (SAVE_KEY); 

290:  GOTO  READ_NEXT_RECORD; 


291:  /*****  SUBROUTINE  TO  PRINT  THE  SUMMARY  BY  COUNTIES  *****/ 


SUMMAPY_BY_COUNTIES: 
#_HDGS  =  2; 
PRINTER  =  ■  • ; 

SUBSTR(PRINTER, 46,45)=* **********  SUMMARY  BY  COUNTIES  *********** 
#_LINES  =  #_COUNTIES  ♦  5; 

IF  #_LINES>6  THEN  #_LINES  =  #_LINES  ♦  2; 
IF  OUT_OF_STATE.ROUTE-.=  0  THEN  #_LINES  =  #_LINES  ♦  2; 
CALL  PRINTXA  ( F( 2 ) , #_L INES ) ; 
PRINTER  =  •  ROUTE   CONST    UNIMP    WYE  ■  I 

•     CITY  COUNTY   NATFOR   INDRES   OTHER    NET 
CALL  PRINTX  (F(2)) ; 
J.CAPRIAGE  =  2; 
J3  =  o; 
TOTALS  =  0; 
DO  Jl=l  TO  3; 

DO  J2=l  TO  56; 

IF  ACNTY(J2» J1)=0  THEN  GO  TO  NEXT.COUNTY; 

TOTALS  =  TOTALS  ♦■  MBC  (  ACNTY(  J2  ,  Jl  )  )  ; 

J3  =  J3  f  l; 

ML  =  MBC(ACNTY( J2,J1I)  ; 

PRINTER    =    C0UNTYU2)     I  I    CODEC  Jl)     II     STRING_ML; 
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/*  :LIST_&_SUM,REPORT=ROADLOG, DATA=XXXXX  */ 
CALL  PRINTX  ( F< J_CARR I AGE M ; 


313 

314 

315 

316 

317 

318 

319 

320 

321 

322 

323 

324 

325 

326 

32  7 

328 

329 

330 

331 

332 

333 

334 

335 

336 

337 

338 

339 

340 

341 

342 

343 

344 

345 

346 

347 

348 

349 

350 


NEXT_CGUNTY: 

end; 
end; 

IF  J3>1  THEN  00; 

ML  =  TOTALS; 

PRINTER  =  «    TOTAL  '  II  STRING_ML; 

CALL  PRINTX  (F(2>); 

END; 
IF  OUT_QF_STATE.R0UTE-.=0  THEN  DO; 

ML  =  OUT_OF_STATE; 

PRINTER  ■  ■   +  OUT  OF  STATE       f  II  STRING_ML; 

CALL  PRINTX  (F(  1)  )  ; 

TOTALS  =  TOTALS  +  OUT_OF_STATE  *. 

ML    =    TOTALS; 

PRINTER    =     '  TOTAL  '     II     STRING_ML; 

CALL    PRINTX     (F(  1)  )  ; 

END; 
RURAL_MILEAGE    =    TOTALS. CNTY    +    TOTALS. NFOR    ♦    TOTALS. IRES    + 

TOTALS. OTHR    -    DUPLICATE    -    OUT_OF_ST ATE. CONST; 
PRINTER    =    •     • ; 

SUBSTR(PRINTER,94, 10)    =    RURAL_MILE AGE ; 
CALL    PRINTX     (F(0)); 
IF     TOT_CONST-.=TOTALS.  CONST    THEN    DO; 

CALL  ASTER; 

PRINTER  =  '***  CONSTRUCTED  MILEAGE  IN  ERROR:   •  ||  TOT_CONST; 

CALL  PRINTX  (F(2I); 

CALL  ASTER; 

END; 
IF  PAGE_SIZE-PAGE_P0SITI0N>2  THEN  DO; 

PRINTER  =  LINES; 

CALL  PRINTX  (F(2) )  ; 

END; 
INIT_FLAG  =  ' I1 ; 
#_HDGS  =  5; 
IF  SU8STR(RLG2.KEY,1,4)>=ENDKEY  THEN  GOTO  RETURN; 

GOTO  READ_NEXT_RECORD; 


. 


351:  END  LISTSUM; 
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SURF-TYPE  —  SURF-TYPE  is  implemented  in  two  separate  programs:   NDR 
and  NDR1.   NDR1  is  invoked  when  SUMMARY=RTE-NO  is  specified,  unless  DATA=ILOOP 
is  also  specified.   NDR  is  invoked  in  all  other  cases. 

MAIN  PHASE: 

Member  Name NDR 

Language PL/I 

Subroutines  PRINTX1 

SDC 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  SURF-TYPE  output 

ROADLOG  —  Roadlog  file 

PROJTBL  —  Project  Class  table 

SURFTBL  —  Surface  Type  table 

CITYTBL  —  City  name  table 

CNTYTBL  —  County  name  table 

Instruction 1  -   3  "NDR" 

»1t«/"2"/"3"/»4»/"5"/»6,7"7,7  for 

SUMMARY=RTE-NO/PROJ-#/COUNTY/ 
CITIES/YR-BLT/SUR-WD/YR-IMP 

"A"/"U"  for  MILEAGE=ALL/URBAN 

"l"/tlp"/"S,7,IC,7,,A,7"L,7"  "  for 
DATA= INT/PRIM/SEC/ INT+PRIM/ 
ALL/ILOOP/all-other 

Beginning  key 

Ending  key 

NDR  calculates  and  prints  all  of  the  surface  type  summaries  other 
than  SUMMARY=RTE-NO  (it  also  produces  SUMMARY=RTE-NO  if  DATA= 
ILOOP  is  specified) .   Out-of-state  mileage  ("OS"  records)  is 
not  included  in  the  summaries.   The  program  operates  in  several 
modes,  depending  upon  the  options  specified.   These  modes  may  be 
referred  to  as  loop,  urban,  municipal,  and  normal  modes.   The 
program  operates  in  loop  mode  whenever  DATA= ILOOP  is  specified, 
requesting  a  summary  of  Interstate  loop  mileage.   In  this  mode, 
the  Primary  system  is  scanned  for  "IL"  (Interstate  loop  defini- 
tion) records.   When  one  is  found,  the  beginning  and  ending  keys 
of  the  loop  are  formed  from  the  description,  and  the  loop  read. 
Each  mileage  record  within  the  loop  (NOTE:   there  is  no  out-of- 
state  mileage  on  the  Interstate  system)  is  processed  if  MILEAGE= 
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1  - 

3 

4 

5 

6 

40  - 

52 

56  - 

68 

ALL;  only  those  occurring  in  a  city  of  population  5000  or  greater 
are  processed  if  MILEAGE=URBAN .   If  DATA=IL00P  is  not  specified 
and  MILEAGE=URBAN  is  specified,  the  program  operates  in  urban 
mode.   In  this  mode,  the  program  begins  searching  at  the  point 
specified  in  the  DATA  parameter,  and  scans  until  the  end  point 
specified.   Each  record  is  tested  for  a  population  code  of  4 
or  greater  (5000  or  more).   Any  such  record  is  processed.   Note 
that  this  method  automatically  eliminates  descriptor  records, 
which  contain  a  population  code  of  0.   No  test  is  needed  for 
out-of-state  mileage,  as  there  is  no  urban  out-of-state  mileage. 
Municipal  mode  is  entered  if  neither  DATA=IL00P  nor  MILEAGE= 
URBAN  is  specified,  but  SUMMARY=CITIES  is.   In  this  mode,  the 
program  searches  the  data  range  for  (mileage)  records  containing 
a  location  code  of  CITY  (stored  in  the  file  as  a  decimal  value 
of  1).   Again,  descriptor  records  are  eliminated  because  these 
do  not  have  location  codes  present.   No  test  is  needed  for 
out-of-state  mileage,  as  there  is  no  municipal  out-of-state 
mileage.   Normal  mode  is  used  in  all  other  cases.   In  this 
mode,  the  data  range  is  searched  for  records  containing  "  ," 
"SP,"  "LP,"  or  "NE"  codes  (all  mileage  records  other  than  "OS" 
out-of-state  records) .   No  matter  which  mode  of  operation  is 
utilized,  the  procedure  SAVE_MILEAGES  is  invoked  each  time  a 
record  is  found  for  processing.   This  internal  subroutine 
checks  the  4th  character  of  the  instruction  for  the  summary 
type,  and  sets  a  subscript  (Jl)  to  the  value  of  the  appropriate 
parameter.   If  SUMMARY=CITIES  and  either  DATA=IL00P  or 
MILEAGE=URBAN  is  specified,  SAVE_MILEAGES  may  be  invoked  with 
non-municipal  records  due  to  the  mode  of  operation;  hence,  if 
Jl  is  zero  in  this  case,  an  immediate  return  is  taken.   At 
all  other  times  when  Jl  takes  on  a  zero  value,  an  error  message 
is  printed  —  the  parameter  has  not  been  coded  on  a  mileage 
record.   For  each  value  the  parameter  may  take  on,  16  array 
elements  may  be  required  —  8  for  rural  and  8  for  municipal 
mileage.   (Eight  surface  type  categories  are  summarized  on.) 
In  the  worst  case  (SUMMARY=CITIES) ,  126x8x2  decimal  (7,3) 
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variables,  or  8064  bytes,  are  required.   However,  when  SUMMARY= 
CITIES  is  specified,  only  municipal  mileage  will  be  present, 
causing  a  direct-access  method  to  set  up  twice  as  much  core  as 
will  be  needed.   Hence,  to  save  core,  an  indirect  method  is 
utilized.   This  method  of  storage  allocation  is  explained  above, 
under  "LIST-&-SUM."   In  NDR,  the  array  MILES  is  equivalent  to 
LIST-&-SUM's  array  MBC,  POINTERS  is  equivalent  to  ACNTY,  and 
#_PARMS  is  equivalent  to  #_C0UNTIES.   After  calculating  Jl 
(based  on  the  summarizing  parameter) ,  J2  is  set  to  1  for  rural 
and  2  for  municipal.   Storage  is  then  allocated  if  POINTERS 
(J1,J2)  is  zero.   If  non-zero,  PO INTERS (Jl,J2)  contains  a 
pointer  into  MILES  into  which  the  mileage  is  to  be  added. 
After  allocating  storage,  the  program  examines  the  Roadlog 
4-digit  surface  type  code  (the  larger  code  is  used  to  allow 
other  breakdowns  than  the  usual  one,  such  as  for  State  Mileage 
reports) ,  and  sets  J4  to  a  value  between  1  and  8  as  specified 
in  the  surface  type  table.   The  Roadlog  section  length  is 
added  into  MILES,  and  a  return  is  taken  to  the  proper  mode 
of  operation.   After  scanning  all  of  the  Roadlog  records  in 
the  data  range,  the  summary  is  printed.   Depending  upon  the 
SUMMARY  parameter,  the  program  may  have  to  read  one  of  the 
tables  PROJTBL,  CNTYTBL,  or  CITYTBL  to  obtain  row  headings. 
POINTERS  is  then  scanned  on  the  first  subscript,  ensuring  that 
the  parameter  values  will  be  printed  from  the  smallest  to  the 
largest  value.   Each  time  a  non-zero  value  is  found,  the  row 
heading  and  the  rural  and  municipal  mileage  (and  a  total)  is 
set  up  in  structure  MLGE.   This  structure  is  passed  to  an 
external  subroutine  SDC  (also  used  by  NDR1) ,  which  performs 
the  actual  printing.   As  each  line  is  set  up  for  printing, 
the  array  TOTALS  is  accumulated,  giving  the  total  rural  and 
municipal  values  in  the  summary.   A  final  call  to  SDC  prints 
the  totals . 

The  SDC  and  NDR  program  listings  follow: 
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SOC:   PROCEDURE  (MILEAGES); 

1:  SOC:   PROCEDURE  (MILEAGES); 


8 
9 
10 
11 
12 
13 
14 
15 
16 
17 
18 
19 
20 


27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 
39 
40 
41 
42 
43 
44 
45 
46 
47 


[ 
[ 


2:  /*****  ROUTINE  TO  PRINT  ONE  SECTION  OF  SUMMARY 

4*:  /*****  THREE  LINES  ARE  PRINTED:   ONE  FOR  RURAL,  ONE  FOR  MUNIC,   ***** 

5:  /*****         AND  ONE  FOR  TOTAL  MILEAGE  FOR  THE  GIVEN  PARAMETER.****^ 

6:  /*****  MILEAGES  AND  ROW  HEADING  ARE  PASSED  BY  CALLING  PROCEDURE  ****|_ 

7:  /*****  DECLARATION  OF  VARIABLES  (ALPHABETICAL  ORDER)  *****/ 


DECLARE 

#_LINES  PIC'ZZ', 

F(0:9)  PIC'Z'  INIT(0,  I, 2,3,4,5,6,7,8,9) ,  L 

MILEAGES  CHAR(160)  , 

1   MLGE  DEF  MILEAGES,  r 

3       HOG    CHAR(20) ,  L 

3       M{9,2)     PIC'ZZZZVZZZ' , 
PRINTER    CHAR( 132)     EXT, 
STRING_STRCT    CHAR (1 15 >    DEF    STRCT, 
1       STRCT,  L 

3       HOG    CHAR (20) , 

3       RUR.MUN    CHAR (5)  ,  f 


3     S(9)    piczzzzzzv.zzz' ; 

2i:  /*****  ROUTINE  INITIALIZATION  *****/ 


22:  ON  ERROR  BEGIN; 

23:         PRINTER  =  •***  TERMINAL  ERROR  IN  SRTYPP  PHASE' 

24:        CALL  PRINTX  (F(2) )  ; 

25:        GO  TO  RETURN; 

26:        END; 


/*****  MAIN  PROGRAM  BODY  *****/ 

IF  MLGE.M(9,l)-=0  THEN  Jl  =  1;   ELSE  Jl  =  0; 

IF  MLGF.M(9,2)-=0  THEN  J2  =  1;   ELSE  J2  =  0; 

IF  J1+J2>1  THEN  #_LINES  =  4;   ELSE  #_LINES  =  2; 

PRINTER  =  *  • ; 

CALL  PRINTXA  ( F( 1 ) , #_L INES ) ; 

STRCT. HDG  =  MLGE. HOG; 

IF  Jl=l  THEN  DO; 

STRCT. RUR.MUN  =  'RURAL'; 

STRCT. S  =  MLGE.M(*,1) ; 

PRINTER  =  STRING_STRCT; 

CALL  PRINTX  (F(l)); 

STRCT. HDG  =  '  ' ; 

END; 
IF  J2=l  THEN  DO; 

STRCT. RUR_MUN  =  'MUNIC; 

STRCT. S  =  MLGE.M(*,2); 

PRINTER    =    STRING_STRCT; 

CALL    PRINTX     (F(  II  )  ; 

END; 
IF    JH-J2M    THEN    DO; 
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SDC 


PROCEDURE  (MILEAGES); 


48 
49 
50 
51 
52 


STRCT.RUR.MUN  =  'TOTAL'; 

STRCT.S  *  MLGE.M(*,1)  ♦  MLGE.M<*,2>; 

PRINTER  =  STR ING_STRCT; 

CALL  PRINTX  (F(l)»; 

end; 


53:  RETURN: 


54:  END  SDC; 
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/*     :SURF_TYPE,REPORT=ROADLOG,SUMMARY=XXXXX,DATA=XXXXX,MILEAGE=XXXXX    */ 

l:  /*     :SURF_TYPE,REPORT=R0ADLOG,SUMMARY=XXXXX,DATA=XXXXX,MILEAGE=XXXXX 

2:  SURFTYP:       PROCEDURE     (PARM)    OPTIONS    (MAIN); 

3:  /*    PRINT    SUBROUTINE    */ 

4:  DECLARE 

5:  PARM    CHAR( 100)  , 

6:  INSTR    CHAR(80)     EXT, 

7:  #_HDGS    PIC'Z'    DEF     INSTR    P0S(72), 

8:  BLANKS    CHARI132)     STATIC     INIT     (•     •), 

9:     F(C:9)  PIC'Z'  STATIC  INIT  (0,1,2,3,4,5,6,7,3,9), 
10:     HEADING(9)  CHAR(132)  EXT, 
11:     PRINTER  CHAR(132)  EXT; 

12:  /*  INSTRUCTION  */ 

13:  DECLARE 

14:     REPORT  CHAR(i)  DEF  INSTR  P0S(3), 

15:     SUMMARY  CHAR<1)  DEF  INSTR  P0S(4), 

16:     SUMMARY.*  PIC'Z'  DEF  INSTR  P0S(4), 

17:     URPAN_IND  CHAR(l)  DEF  INSTR  P0S(5), 

18:     SYSTEM  CHAR(l)  DEF  INSTR  P0S(6), 

19:     STARTKEY  CHAR(l6)  DEF  INSTR  P0S(40), 

20:     ENDKEY  CHAR(16)  DEF  INSTR  P0S(56); 


21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 
39 
40 
41 
42 
43 
44 
45 
46 
47 
48 
49 
50 
51 
52 
53 
54 


/*  ROAOLOG  FILE  */ 
DECLARE 

1   RLG  BASED  (PTR.RLG), 
3   DUM1  CHAR( 1) , 
3   SYSTEM  CHAR(  1), 
3   RT_#  PIC'999', 
3   MILEPOST  PIC'ZZZ', 
3   PLUS  CHAR(  1)  , 
3   OFFSET  PIC'ZV.ZZZ', 
3  REMARK  CHAR(2)  , 

3  (SECTN, ROUTE, CONST, UNIMP)  DEC  FIXED(5,3), 
3  WYE  DEC  FIXED(3,3), 
3   DESCR  CHAR(35), 
3  PROJECT_CLASS  CHAR* 11), 
3  DIVIDED.CODE  CHAR(l), 

3  (#_LANES,POPULAT  ION_CODE)  DEC  FIXED(1,0), 
3  (CITY_#,CQUNTY_#,YR_BLT,YR_IMP,FORHWY_#,ADMIN_CnDE, 

L0CN(2 ) ,PROJ_CLASS,SURF_WlDTH,RDWAY_WIDTH)  DEC  FIXED(3,0), 
3  (SURF_THICKNESS,BASE_THICKNESS)  DEC  FIXED(3,1), 
3  DUM4  CHARd  ), 

3  ( SURF_TYPE,MAINT_SEC)  DEC  FIXED(5,0), 
3  DATE, 

5  (MONTH, DAY, YEAR)  DFC  FIXED(3,0), 
3  DUM3  CHAR(2)  , 
1   RLG2  BASED  (PTR_RLG) , 
3   DUM1  CHARd), 
3   KEY  CHAR( 13) , 
3  DUM2  CHAR( 16)  , 
3   CN, 

5   DUM1  CHAR( 5) ,  L 

5   RT_#  CHAR(4) , 

5       DUM2    CHAR(6) ,  I 

5       KEY(2)     CHAR(  10)  ,  (. 

ROADLOG    FILE    RECORD    KEYED    ENV (  INDE XED  )  ; 
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L 


/*  :SURF_TYPE,REPORT=ROADLOG,SUMMARY=XXXXX,DATA=XXXXX,MILEAGE=XXXXX  */ 


55 
56 
57 
58 
59 
60 
61 
62 
63 
64 
65 


69 
70 
71 
72 
73 
74 
75 
76 
77 
78 
79 


/*  OTHER  VARIABLES  */ 
DECLARE 

MAX_#_PARMS  DEC  FIXED  (3)  STATIC  INIT  (130), 

MILES(130,8)  DEC  FIXED  (7,3)  STATIC, 

POINTERS( 130,2)  DEC  FIXED  (3)  STATIC, 
( #_PARMS,#_PROJS)  DEC  FIXED  (3)  STATIC  INIT  (0), 

#_SURF_TYPES  DEC  FIXED  (2)  STATIC, 

SUPTYP(50,2)  DEC  FIXED  (4)  STATIC, 

C4  CHAR(4)  STATIC, 

PRJ  CHAR(5)  BASED  (PTR_TBL), 

PRCJ(70)  CHAR(4)  STATIC; 


66:  /*****  INITIALIZATION  *****/ 

67:     CALL  INIT  (PARM); 
68:     CALL  SET_HDGS; 


/*  IF  SUMMARY=PROJ_*  READ  PROJTBL  */ 
IF  SUMMARY='2'  THEN  DO; 

OPEN  FILE  (TABLE)  INPUT  RECORD  TITLE  ('PROJTBL'); 
ON  ENDFILE  (TABLE)  GOTO  F  INPROJ ; 
DO  #_PR0JS=1  TO  70; 

READ  FILE  (TABLE)  SET  (PTR_TBL); 
PROJ (#_PROJS )  =  PRJ; 
END; 
FINPROJ: 

CLOSE  FILE  (TABLE); 

end; 


80:  /*  INITIALIZE  ROADLOG  FILE  */ 

81:  OPEN  FILE  (ROADLOG)  INPUT  SEQL; 

82:  ON  ENDFILE  (ROADLOG)  GOTO  PR INT_SUMMARY; 

83:  READ  FILE  (ROADLOG)  SET  (PTR_RLG)  KEY  (STARTKEY) 

84:  /*  INIT  VAR  */ 

85:  MILES  =  0; 

86:  #_PARMS  -    0; 

87:  POINTERS  =  C; 

88:  /*  CHECK  FOR  SUMMARY  TYPE  ♦/ 

89:  IF  SYSTEM='L'  THEN  GOTO  INT_LOOPS; 

90:  IF  URBAN_IND='U'  THEN  GOTO  URBAN; 

91:  IF  SUMMARY='4'  THEN  GOTO  CITY; 


92:  /*****  EXECUTION  LOOPS  *****/ 

93:     DO  WHILE  (RLG2 .K EY<=ENDKEY  )  ; 

94:         IF  RLG.REMARK=«   •  |  RLG. R EMARK= • LP '  I  R LG . REMARK= • SP' 

95:  RLG.REMARK='NE' 

96:  THEN  CALL  SAVE_MI LEAGES ; 

97:        READ  FILE  (ROADLOG)  SET  (PTR_RLG); 

98:         END; 

99:     GOTO  PRINT.SUMMARY ; 

100:  URBAN: 
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/*     :$URF_TYPE,REPORT=ROA0L0G,SUMMARY=XXXXX,DATA=XXXXX,MILEAGE=XXXXX    */ 

101:  DO    WHILE    (RLG2 .KEY<=ENDKEY ) \ 

102:  IF    RLG.P0PULATI0N_C0DE>=4    THEN    CALL    S AVE_MI L EAGES ; 

103:  READ    FILE    (ROADLOG)    SET     (PTR_RLG); 

104:  END; 

105:  GOTO  PRINT_SUMMARY ; 

106:  CITY: 

107:  DO  WHILE  ( RLG2 .KEY<=ENDKEY ) ; 

108:  IF  RLG.LOCN( l)=i  THEN  CALL  SAVE_MI LEAGES; 

109:  READ  FILE  (ROADLOG)  SET  (PTR.RLG); 

110:  END; 

111:  GOTO  PRINT_SUMMARY; 

112:  INT_LOOPS: 

113:  DO  WHILE  ( RLG2 .K EY<=FNDKEY )  ; 

114:  IF  RLG.REMARK=« IL'  THEN  CALL  IL_REC0RD; 

115:  READ  FILE  (ROADLOG)  SET  (PTR_RLG); 

116:  END; 

117:  PRINT_SUMMARY: 

118:  CLOSE  FILE  (ROADLOG); 

119:  CALL  GEN_SUMMARY; 

120:  RETURN: 

121:  CLOSE  FILE  (ROADLOG); 

122:  CALL  EXIT  (PARM) ; 

123:  RETURN; 

124:  /*****  SUBROUTINE  TO  CALCULATE  HEADINGS  *****/ 

125:  SFT_HDGS:   PROCEDURE; 


126 

127 

128 

129 

130 

131 

132 

133 

134 

135 

13b 

137 

138 

139 

140 

141 

142 

143 

144 

145 

146 

147 

148 

149 

150 


DECLARE 

BK7)  DEC  FIXED  (2)  STATIC  INIT  (41,41,44,45,42,41,41), 
B2(12)  DEC  FIXED  (2)  STATIC  INIT 

(42,40,40,44,44,44,   42 , 38 , 41 ,44, 45 ,41 )  , 
(J1,J2)  DEC  FIXED, 
1   STYP  BASED  (PTR_TBL) , 
3   S(2)  PIC'ZZZZ', 
3   DUM  CHAR(7) , 
3   HD(2)  CHAR(12), 
SUM_HDG(7)  CHAR(13)  STATIC  INIT 

(•ROUTE  NUMBER' , 'PROJECT  CLASS ', 'COUNTY ',' C I TY • , 
•YEAR  BUILT' , 'SURFACE  WIDTH', 'YEAR  IMPROVED'), 
SUMK7)  CHAR(20)  STATIC  INIT  ( 

'  ROUTE', '  PROJFCT','  ','  ', 

•  YEAR','  SURFACE', '  YEAR') 
SUM?(7)  CHAR(20)  STATIC  INIT  ( 

•  NUMBFR' , '  CLASS' , 

•  COUNTY','  CITY','  BUILT', 

•  WIDTH','  IMPROVED'), 
SYS_HDG(12)    CHAR(50)     STATIC     INIT     ( 

'      FEDERAL  AID  INTERSTATE  SYSTEM', 

•FEDERAL  AID  PRIMARY  SYSTEM— LESS  INTERSTATE', 

•FEDERAL  AID  PRIMARY  AND  INTERSTATE  SYSTEMS', 

•  FEDERAL  AID  SECONDARY  SYSTEM', 

•  ALL  SYSTEMS', 
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/*  : S URF_TY PE, REPORT =ROA DL OG, SUMMAR Y= XXXXX, DAT A=X XX XX, MILE  AGE  =  XXX XX  */ 


151 
152 
153 
154 
155 
156 
157 
158 
159 
160 
161 
lt>2 
163 
164 
165 
166 
167 
168 
169 
170 
171 
172 
173 

174 

175 
176 
177 
178 
179 
180 
181 
182 
183 
184 
185 
186 
187 
188 
189 
190 


IF 


FED 

FED 


SUBSTR( 
HEADING 
•NET 
SYST 
ELSE 
ELSE 
ELSE 
ELSE 
ELSE 
ELSE 
Jl-= 
Jl-= 
HEADING 
SUBSTR( 
HEADING 
#_HDGS 


NON-CH 

FEDE 

EPAL  A 

ERAL  A 

FEDER 

IN 
HEADIN 
(2)  = 

CONST 
EM=«  P 

IF  SY 


ARGEABLE  PARALLEL  MILEAGE', 

RAL  AID  INTERSTATE  URBAN1, 

ID  PRIMARY  URBAN — LESS  INTERSTATE  URBAN' 

ID  PRIMARY  AND  INTERSTATE  URBAN*, 

AL  AID  SECONDARY  URBAN', 

ALL  URBAN', 
TERSTATE  LOOPS — URBAN' I; 

G(l),51,24)  =  'SUMMARY  OF  SURFACE  TYPES' 
SUBSTRC BLANKS, I , B 1 ( SUMMAR Y_#) )  I  I 


RUCTED 


SY 
SY 

SY 
SY 


IF 
IF 


IF 
IF 
IF 
IF 
Jl  = 

o  a  ur 

0  THEN 

(5)  = 
HEADIN 

(6)  = 

=  7; 


•  BY  '  ||  SUM.HDGt SUMMARY_#) ; 

THEN  Jl 
STEM='P' 
STEM='C 
STEM='S' 
STEM=» A» 
STEM='L' 
0; 
BAN_IND='U«  THEN  Jl  =  Jl  +  6; 

HEA0ING(3)  =  SUBSTR(BLANKS,1,B2( Jl) ) 
SUMK  SUMMARY_#)  ; 
G<5), 109,5)  =  'TOTAL'; 
SUM2( SUMMAR Y_#) ; 


LENGTH 

=  l; 

THEN 
THEN 
THEN 
THEN 
THEN 


Jl 
Jl 
Jl 
Jl 
Jl 


2; 

3; 
4; 
5; 
6; 


| |  SYS_HDG( Jl) 


TYPE  TABLE  */ 


/*  READ  SURFACE 
IF  REPQRT-*='Q» 

THEN  OPEN  FILE  (TABLE)  INPUT  RECORD 

ELSE  OPEN  FILE  (TABLE)  INPUT  RECORD 
ON  ENDFILE  (TABLE)  GOTO  CONTINUE; 
SURTYP  =  o; 
DO  #_SURF_TYPES=1  TO  50; 

READ  FILE  (TABLE)  SET  (PTR_TBL); 

SURTYP(#_SURF_TYPES,*)  =  STYP.S; 

J2  =  18  +  STYP.S(2)*10; 

SUBSTR(HEADING( 5),J2,10)=STYP.HD(1) 

SUBSTR(HEADING(6), J2, 10  J  =  STYP .HD ( 2 ) 

END; 
CONTINUE: 

#_SURF_TYPES  ■  #_SURF_TYPES  -  1; 
CI  OSE  FILE  (TABLE)  ; 
END  SET_HDGS; 


TITLE  (  » SURFTBL'  )  ; 
TITLE  (  • SMSFTBL' )  ; 


191:  /*****  SUBROUTINE  TO  ACCUMULATE  MILEAGES  *****/ 

192:  SAVE.MILEAGES:   PROCEDURE; 

193:  DECLARF  ( J  1, J2, J3, J4)  DEC  FIXED; 


194 
195 
196 
197 
198 
199 
200 
201 
202 


IF  SUMMARY='l'  THEN  Jl  =  RLG.RT_#; 

ELSE  IF  SUMMARY='2'  THEN  Jl  =  RLG.PROJ_CL ASS ; 


ELSE  IF  SUMMARY='3'  THEN  Jl  = 


ELSE  IF 

ELSE  IF 

ELSE  IF 

ELSE  IF 


SUMMARY='4' 
SUMMARY='5' 
SUMMARY='6' 
SUMMARY=«7« 


THEN  Jl 

THEN  Jl 

THEN  Jl 

THEN  Jl 


IF  J1=0  THEN  DO; 


RLG.COUNTY_#; 
RLG.CITY_#; 
RLG.YP_BLT; 
RLG.SURF_WIDTH; 
RLG.YR  IMP; 


IF  SUMMARY='4'  THEN  RETURN; 
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/*  :SURF  TYPE,REPORT=R0ADL0G,SUMMARY=XXXXX,0ATA=XXXXX,MILEAGE=XXXXX  */ 


203 


PRINTER  =  '***  PARAMETER  HAS  ZERO  VALUE  AT  KEY  =  •  II  PLG2.KEY 

204:  CALL  PRINTX  (F(1M; 

205:  Jl  =  l; 

206:  END*. 

207:  IF  RLG.LOCN< 1)=1 

208:  THEN  J2  =  2; 

209:  ELSE  J2  =  i; 


210:  /*  ALLOCATE  STORAGE  IF  NECESSARY  */ 

211:  IF  P0INTERS(JltJ2)=0  THEN  DO; 

212:  #_PARMS  =  #_PARMS  +  1; 

213:  IF  #_PARMS>MAX_#_PARMS  THEN  DO; 

214:  PRINTER  =  •***  STORAGE  ALLOCATION  EXCEEDED'; 

215:  CALL  PRINTX  (F(3)>; 

216:  GOTO  RETURN; 

217:  END; 

218:  PCINTERSUltJ2)  =  #_PARMS; 

219:  END; 


220 
221 
222 
223 
224 
225 
226 
227 
228 
229 
230 
231 


238 
239 
240 
241 
242 
243 
244 
245 
246 
247 
248 
249 
250 
251 
252 
253 


/*  GET  SURFACE  TYPE  */ 

J4  =  RLG.SURF_TYPE; 

DO  J3=l  TO  #_SURF_TYPES; 

IF  J4=SURTYP( J3,l)  THEN  GOTO  SAT  I SF I E D_SURFACE_TYPE ; 

end; 
PRINTER  =  •***  SURFACE  TYPE  (•  II  RLG. SURF_TYPE  II 

•)  UNKNOWN  AT  KEY  =  •  II  RLG2.KEY; 
CALL  PRINTX  (F(  1)  )  ; 
J3  =  l; 
GOTO  ADD; 
SATISFIED_SURFACE_TYPE: 
J3  =  SURTYPt J3,2); 


232:  AOD: 

233:     Jl  =  POINTERS! Jl,J2»; 

234:     MILES(J1,J3)  =  MILES(J1»J3»  +  RLG.SECTN; 

235:     END  SAVE_M ILEAGES; 


236:  /*****  SUBROUTINE  TO  PROCESS  INTERSTATE  LOOPS  *****/ 
237:  IL_RECORD:   PROCEDURE; 


DECLARE  (KEY1,KEY2,SAVE_KEY)  CHAR(16); 
SAVE.KEY  =  RLG2.KEY; 

KEY1  =  RLG2.CN. RT_#  I  I  RLG2 .CN .KEY ( 1 ) ; 
KEY2  =  RLG2.CN. RT_M  II  RLG2 . CN.KE Y ( 2 ) ; 
ON  KEY  (ROADLOG)  BEGIN; 

PRINTER  =  •***  NO  RECORD  FOR  ILUOP  SECTN  '  II  KEY1  || 
«  AT  ROADLOG  RECORD  •  | |  SAVE_KEY; 

CALL  PRINTX  (F{  1)  )  ; 

GOTO  back; 

END; 
RFAD  FILE  (ROADLOG)  SET  (PTP_RLG)  KEY  (KEY1); 
DO  WHILE  (RLG2.KEY<KEY2) ; 

IF  RLG.SECTN-.  =  0  L     (UR  BAN_  IND-=  •  U»  |  R  LG.  POPULA  T  I0N_C0DE>  =  4) 
THEN  CALL  S AVF_MI L E AGES ; 

READ  FILE  (ROADLOG)  SET  (PTR.RLG); 

END; 
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/*  :SURF_TYPE,REPORT=ROADLOG,SUMMARY=XXXXX,DATA=XXXXX,MILEAGE=XXXXX  */ 

254:  BACK: 

255:     READ  FILE  (ROADLOG)  SET  (PTR.RLG)  KEY  (SAVE_KEY); 

256:     END  IL.RECORD; 

257:  /*****  SUBROUTINE  TO  FORMAT  L    PRINT  SUMMARY  *****/ 
258:  GEN.SUMMARY:   PROCEDURE; 


259 
260 
261 
262 
263 
264 
265 
266 
267 
268 
2  69 

270 
271 
272 
273 
274 
275 
276 
277 
278 
279 
280 
281 
282 
283 
284 
285 
286 
287 
288 
289 
290 
291 
292 

293 
294 
295 
296 
297 
298 
299 
300 
301 
302 
303 
304 


DECLARE 

CHD(132)  CHAR(20), 
DON  CHARI8) , 
( Jl, J2, J3, J4)  DEC  FIXED, 
MILEAGES  CHAR(160) , 
1   MLGE  DEF  MILEAGES, 
3   HOG  CHAR(20) , 
3   M(9,2)  PIC»ZZZZVZZZ' , 
NHD(  132)  PIC  BB8BBBBB6BZZZZZBBBBB'  , 
T0TALS(9,2)  DEC  FIXED  (7,3), 
RECORD  CHAR(80)  BASED  (PTR_TBL); 

CHD  =  »  •  ; 

IF  SUMMARY=,1'  I  SUMMARY>'4»  THEN  DO  Jl=l  TO  100; 
IF  SUMMARY=«5'  |  SUMMAPY=»7' 

THEN  NHD(Jl)  =  Jl  ♦  1900; 

ELSE  NHD(Jl)  =  Jl; 
CHD(Jl)  =  NHD(Jl); 
END; 
ELSE  IF  SUMMARY='2'  THEN  DO  J 1= 1  TO  #_PROJS; 
SUBSTR(CHD(  Jl)  ,12,4)  =  PR0JU1); 
END; 
ELSE  DO; 

IF  SUMMARY=«3' 

THEN  DO;   J2  =  15;   DDN  =  'CNTYTBL1;   END; 

ELSE  DO;   J2  =  18;   DDN  =  'CITYTBL';   END; 
OPEN  FILE  (TABLE)  INPUT  RECORO  TITLE  (DDN); 
ON  ENDFILE  (TABLE)  GOTO  CLOSE_TABLE; 
DO  J3=l  TO  200; 

READ  FILE  (TABLE)  SET  (PTR_TBL); 

CHD(J3)  =  SUBSTR(REC0RD,1,J2); 

END; 
CLOSE.TABLE: 

CLOSE  FILE  (TABLE); 

end; 
/*  print  the  summary  */ 

TOTALS  =  0; 

DO  Jl=l  TO  MAX_#_PARMS; 

IF  POINTERS(Jl,l)-=0  |  P0INTERS(Jl,2)-=0  THEN  DO; 
MLGE.M  =  0; 
DO  J2=l  TO  2; 

IF  POINTERS( Jl, J2)=0  THEN  GOTO  IGNORE; 
J3  =  POINTERS( Jl, J2)  ; 
DO  J4=l  TO  8; 

MLGE.M( J4,J2)  =  M IL ES( J3 , J4) ; 
MLGE.M(9,J2)  =  MLGE.M(9,J2)  +  MILES(J3,J4) 
END; 
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I- 

/*     :SURF_TYPE,REPORT=R0ADL0G,SUMMARY=XXXXX,DATA=XXXXX,MILFAGE-XXXXX    */ 


305:  IGNORE:  END; 

306:  TOTALS    =    TOTALS    +    MLGE.M; 

307:  MLGE.HDG    =    CHD(Jl); 

308:  CALL    SDC    (MILEAGES); 

309:  END; 

310:  END; 


L- 


311:  /*  PRINT  TOTALS  */  r- 

312:     MLGE.HDG  =  •  TOTAL' ; 

313:     PRINTER  =  •  • ; 

314:     CALL  PRINTX  (F(l)); 

315:     MLGE.M  =  TOTALS; 

316:     CALL  SDC  (MILEAGES); 

317:     END  GEN_SUMMARY; 

318:  END  SURFTYP; 
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SUMMARY  BY  ROUTE  NUMBER  PHASE: 

Member  Name NDR1 

Language PL/I 

Subroutines  PRINTX1 

SDC 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  SURF-TYPE  output 
ROADLOG  —  Road log  file 
SURFTBL   —  Surface  type  table 

Instruction 1  -  4   "NDR1" 

5  "A"/"U"  for  MILEAGE=ALL /URBAN 

6  "I»/"p"/"s,7"C,7"A,7"  "  for 

DATA= INT/PRIM/SEC/ INT+PRIM/ 
ALL/all-other 
40  -  52   Beginning  Road log  key 
56  -  68  Ending  Roadlog  key 

A  separate  phase  has  been  established  for  summary  by  routes  in 
order  to  conserve  core  storage.   Because  of  the  large  number  of 
Secondary  routes,  a  large  amount  of  storage  would  be  required 
for  a  summary  by  routes  when  DATA=SEC  or  DATA=ALL  is  specified. 
In  the  worst  case  (DATA=ALL) ,  the  amount  of  storage  would  be 
about  400x2x8  decimal  (7,3)  variables,  or  25,600  bytes  of  core. 
However,  because  the  route  system  and  number  comprises  the  first 
portion  of  the  Roadlog  key,  it  is  not  necessary  to  store  all  of 
the  values  in  core  simultaneously.   One  complete  route  may  be 
scanned,  and  its  values  printed.   This  method  will  not  operate 
when  DATA=IL00P  is  specified,  as  the  "IL"  records  do  not  appear 
in  order  by  Interstate  route  number,  but  by  primary  route 
number.   However,  the  IL00P  summary  by  routes  can  be  easily 
obtained  by  NDR.   NDR1  operates  essentially  like  NDR.   It  may 
operate  in  either  urban  or  normal  mode  (loop  and  municipal  mode 
are  not  applicable).   However,  the  program  is  much  simpler  due 
to  the  fact  that  no  indirect  storage  acquisition  is  required. 
NDR1  keys  on  "EN"  records  to  print  a  line  of  output.   Subroutine 
SDC  is  utilized  for  performing  the  actual  printing  —  a  structure 
with  the  route  number  and  the  rural  and  municipal  mileage  for 
that  route  is  set  up  and  passed. 

The  NDR1  program  listing  follows: 
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I 


/*    :SURF_TYPE, REP0RT-R0A9LQG, SUMMAPY=RTF_NO, DATA=XXXXX, MILEAGE=XXXXX     */ 


19 
20 
21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 
39 
40 
41 
42 
43 
44 

45 
46 
47 
48 
49 
50 
51 
52 
53 
54 


l:  /*    :SURF_TYPE,REP0RT=ROADLOG,SUMMARY=RTF_NO,0ATA=XXXXX,MlLEAGE=XXXXX 

2:  SURFTYP:       PROCEDURE    (PARM)    OPTIONS     (MAIN);  ^ 

3:  /*    PRINT    SUBROUTINE    */ 

4:  DECLARE 

5:  PARM    CHAR(IOO) , 

6:  INSTR    CHAR(80)    EXT, 

7:  #_HDGS    PIC'Z*     DEF     INSTR    PUS(72) 

8:  BLANKS    CHARU32)     STATIC     INIT    (•     •>, 

9:  F(0:9)    PIC'Z1     STATIC     INIT    (0,1,2,3,4,5,6,7,8,9), 

10:  HEADING(9)    CHAR(132)     EXT, 

11:  PRINTER    CHAR(132)     EXT; 


, 


; 

[ 
[ 


12:  /*  INSTRUCTION  */ 

13:  DECLARE 

14:     REPORT  CHAR ( 1 )  DEF  INSTR  P0S(3), 

15:     URBAN_IND  CHAR(l)  DEF  INSTR  P0S(5), 

16:     SYSTEM  CHAR(l)  DEF  INSTR  P0S(6), 

17:     STARTKEY  CHAR(16)  DFF  INSTR  POS(40),  ^ 

18:     ENDKEY  CHAR(16)  DFF  INSTR  P0S(56); 


/*  ROADLOG  FILE  */ 
DECLARE 

1   RLG  BASED  (PTR_RLG), 

3   DUM1  CHAR(  1)  , 

3   SYSTEM  CHAR(l), 

3  RT_#  pic'9991 , 

3   MILEPOST  PIC'ZZZ', 

3   OFFSET  CHAR(6), 

3  REMARK  CHAR(2) , 

3  (SECTN, ROUTE, CONST, UNIMPJDEC  FIXED(5,3), 

3   WYE  DEC  FIXFD(3,3), 

3  DESCR  CHAR( 35), 

3    PROJ.CLASS    CHAR( 11) , 

3  DIVIDED_CODE  CHAR(l), 

3    (#_LANES,POPULATION_CODE)DEC    FIXED(1,0), 

3     (CITY_#,COUNTY_#,YR_BLT,YR_IMP,F0RHWY_#,ADMIN_CO0E, 

L0CN(2),PR0J_CL,SURF_WI0TH,R0WAY_WI0TH)     DEC    FIXED(3,0), 

3  (SURF_THICKNESS,BASE_THICKNESS)  DEC  FIXED(3,1), 

3  SURF_TYPE_CODE  DEC  FIXED(1,0), 

3  (SURF_TYPE,MAINT_SEC)  DEC  FIXED(5,0), 

3  DATE, 

5  (MONTH, DAY, YEAR)  DEC  FIXFD(3,C), 
1   RLG2  BASED  (PTR_RLG), 

3   DUMl  CHAR(  1) , 

3   KEY  CHAR( 13)  , 
ROADLOG  FILE  RECORD  KEYED  ENV (  INDF XED  )  ; 


/*  OTHER  VARIABLES  */ 

DECLARE 

SURTYP(50,2)     DEC    FIXED    (4)     STATIC, 
#_SURF_TYPFS    DEC    FIXFO    (2)     STATIC, 
MILEAGES    CHARU60)     STATIC, 
1        MLGE    DEF    MILEAGES, 
3       HDG    CHAR(20) , 
3       M(9,2)     PIC'ZZZZVZZZ* , 
T0TALS(9,2)     DEC    FIXED    (7,3)     STATIC, 
T0TALS1(9,2)     DEC    FIXED    (7,3)     STATIC, 
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/*  :SURF_TYPE,REPORT=ROADLOG,SUMMARY=RTE_NO,DATA=XXXXX,MILEAGE=XXXXX  */ 

55:  SYS_HDG(5)  CHAR(43)  STATIC  INIT  ( 

56:  <      FEDERAL  AID  INTERSTATE  SYSTEM', 

57:  'FEDERAL  AID  PRIMARY  SYSTEM—LESS  INTERSTATE1, 

58:  'FEDERAL  AID  PRIMARY  AND  INTERSTATE  SYSTEMS', 

59:  •     FEDERAL  AID  SECONDARY  SYSTEM', 

60:  •              ALL  SYSTEMS' ) , 

61:  B(5)  DEC  FIXED  (2)  STATIC  INIT  (42,40,40,44,44), 

62:  1   STYP  BASED  (PTR_TBL), 

63:  3   S<2)  PIC'ZZZZ', 

64:  3   DUM  CHAR (7 1, 

65:  3   HD(2)  CHAR(12), 

66:  (J1,J2,J3)  DEC  FIXED  STATIC; 

67:  /*****  INITIALIZATION  *****/ 

68:  CALL  INIT  (PARM); 


69 
70 
71 
72 
73 
74 
75 
76 
77 
78 
79 
80 
81 
82 
83 
84 
85 
86 
87 
88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 

100 

101 

102 

103 

104 


/*  SET  UP  HEADINGS  */ 

SUBSTR(HEADING( 1) ,51,24)  =  'SUMMARY  OF  SURFACE  TYPES'; 

SUBSTR(HEADING(2),42,41)  = 

•NET  CONSTRUCTED  LENGTH  —  BY  ROUTE  NUMBER'; 
IF  SYSTEM='I»  THEN  Jl  =  1; 

ELSE  IF  SYSTEM='P«  THEN  Jl  =  2; 

ELSE  IF  SYSTEM='C  THEN  Jl  =  3; 

ELSE  IF  SYSTEM='S'  THEN  Jl  =  4; 

ELSE  IF  SYSTEM='A«  THEN  Jl  =  5; 

ELSE  Jl  ■  0; 
IF  Jl-.=  0  THEN  HEADING(3)  =  SUBSTR  {  81.  ANKS  ,  1 ,  B(  J  1 )  )  II  SYS_HDG(J1) 
IF  URBAN_IND='U*  THEN  DO; 

SUBSTR(HEADING(4),55,12)  =  'URBAN  SYSTEM'; 

Jl  =  6; 

END; 
ELSE  Jl  =  5; 

SUBSTR(HEADING( Jl) , 16,5)  =  'ROUTE'; 
SUBSTR(HEADING( Jl) ,109,5)  =  'TOTAL'; 
SUBSTR(HEADINGUH-l),  16,6)  =  'NUMBER'; 
#_HDGS  =  Jl  ♦  2; 

/*  READ  TABLE  OF  SURFACE  TYPES  */ 
IF  REPORT-.=  '0' 

THEN  OPEN  FILE  (TABLE)  INPUT  RECORD  TITLF  ('SURFTBL'); 

ELSE  OPEN  FILE  (TABLE)  INPUT  RECORD  TITLE  ('SMSFTBL'J; 
ON  ENDFILE  (TABLE)  GOTO  CONTINUE; 
SURTYP  =  0; 
DO  #_SURF_TYPES=1  TO  50; 

READ  FILE  (TABLE)  SET  (PTR_TBL); 

SURTYP(#_SURF_TYPES,*)  =  STYP.S; 

J2  =  18  ♦  STYP.S(2)*10; 

SUBSTR(HEADING( J1),J2, 10)  =  STYP.HD(l); 

SUBSTR(HEADING( Jl+1) , J2, 10)    =    STYP.HD(2); 

END; 
CONTINUE: 

#_SURF_TYPES  =  #_SURF_TYPES  -  1; 
CLOSE  FILE  (TABLE) ; 


105:     /*  INITIALIZE  ROADLOG  FILE  */ 

106:     ON  ENDFILE  (ROADLOG)  GOTO  F IN  ISH_SUMM AR Y ; 

107:     READ  FILE  (ROADLOG)  SET  (PTR_RLG)  KEY  (STARTKEY) 
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/*  :SURF_TYPE,REPORT=ROADLOG,SUMMARY=RTE_NO,QATA=XXXXX,MILhAGE=XXXXX  */ 

108:  /*  INIT  VAR  */  '^~ 

109:  MILEAGE_IND  =  0; 

110:  MILEAGES  =  ■  •; 

111:  TOTALS  =o; 

112:  /*  CHECK  FOR  URBAN  SUMMARY  */  p 

113:  IF  URBAN_IND=«U'  THEN  GOTO  URBAN; 


114:  /*****  EXECUTION  LOOPS  *****/ 


129 
130 
131 
132 
133 
134 
135 
136 
137 
138 
139 


145 
146 
147 
148 
149 
150 
151 
152 
153 
154 


; 


115:  DO  WHILE  ( Rl G2 .K EY<=ENOKEY ) ; 

116:         IF  RLG.REMARK='   •  |  RLG. R EMARK= • LP '  I  R LG . REMARK= ' SP •  I        r~ 

117:  RLG.REMARK='NE»  [ 

118:  THEN  CALL  SAVE_MILEAGES ; 

119:  ELSE     IF    RLG. REM ARK= • EN*     S    M IL EAGE_I ND= 1     THEN    CALL    PRINTJ.INE; 

120:  READ    FILE     (ROADLOG)     SET     (PTR_RLG); 

121:  END;  ^ 

122:  GOTQ    FINISH_SUMMAPY; 


123:  URBAN: 

124:     DO  WHILE  ( RLG2.K EY<=ENDKEY) ; 

125:  IF    RLG.P0PULATI0N_C0DE>=4    THEN    CALL    S AVE_MI LFAGE S ; 

126:  ELSE     IF    RLG.REMARK=« EN'     &    M ILEAGE_IND=1    THEN    CALL    PRINT_LINF; 

127:        READ  FILE  (ROADLOG)  SET  (PTR_RLG); 

128:        END; 


; 


FINISH_SUMMARY: 

IF  MILEAGE_IND=1  THEN  CALL  PRINT_LINE; 
IF  SYSTEM=»C  THEN  DO; 

MLGE.HDG  =  •   SUBTOTAL  PRIMARY*; 

MLGE.M  =  TOTALS; 

CALL  SDC  (MILEAGES); 

TOTALS  =  TOTALS  ♦  T0TALS1; 

END; 
MLGE.HDG  =  •  TOTALS' ; 

MLGE.M  =  TOTALS; 
CALL  SDC  (MILEAGES); 


140:  RETURN: 

141:     CLOSE  FILF  (ROADLOG); 
142:     CALL  EXIT  (PARM) ; 
143:     RETURN; 


144:  /*****  SUBROUTINE  TO  ACCUMULATE  MILEAGES  *****/ 


SAVE.MILEAGES:   PROCEDURE; 

DECLARE   (J1«J2VJ3)  DEC  FIXED; 
IF  RLG.LOCN(  1)  =  1 
THEN  J3  =  2; 
ELSE  J3  =  1; 
Jl  =  RLG.SURF_TYPE; 
DO  J2=l  TO  #_SURF_TYPES; 

IF  J1=SURTYP( J2,l)  THEN  GOTO  SA T I SF I ED_SURFACE_TYPE ; 
END; 
PKINTER  =  •***  SURFACE  TYPE  (•  II  RLG. SURF_TYPE  I  I 
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/*  : S URF_T Y PE, REPORT =ROA DL CG, SUMM AP Y=RT F_NO, DA TA= XX XXX, MILE AGE = XXX XX  */ 

155:         •)  UNKNOWN  AT  KEY  =  •  II  RLG2.KEY; 

156:     CALL  PRINTX  (F(l)); 

157:     J2  =  l; 

158:     GOTO  ADD; 

159:  SATISFIED_SURFACE_TYPE: 

160:     J2  =  SURTYP( J2,2) ; 

161:  ADD: 

162:     MLGE.M(J2,J3)  =  MLGE.M( J2, J3 )  *  RLG.SECTN; 

163:     MILEAGE_IND  -  1; 

164:     END  S AVE.M IL EAGES ; 

165:  /*****  SUBROUTINE  TO  PRINT  ONE  ROUTE  *****/ 


166 
167 
168 
169 
170 
171 
172 
173 
174 
175 
176 
177 
178 
179 
180 
181 
182 
183 
184 


PRINT_LINE:   PROCEDURE; 

DECLARE  Jl  DEC  FIXED; 
MLGE. HOG= SUBS TR( BLANKS tl, 16) | | SUBSTR ( RLG2 . KF Y, 2 , 3 ) ; 
IF  SU8STR(MLGE.HDG, 17,2)='00«  THEN  SUB STR ( MLGF . HDG *  17 , 2 )  =  '  • 
IF  SUBSTR(MLGE. HDG, 17,1 )='0'  THEN  SUBSTR ( MLGE . HOG, 17 , 1 )  =  '  '; 
DO  J  1=1  TO  8; 

NLGE.MI9,*)  =  MLGE.M(9,*)  +  MLGE  .M  (  J  1 ,  *)  ; 

END; 
TOTALS  =  TOTALS  +  MLGE.M; 
CALL  SDC  (MILEAGES); 
MILEAGE_IND  =  0; 
MLGE.M  =  0; 

IF  SYSTEM^='C»  I  RLG.RT_#-=94  THEN  RETURN; 
MLGE.HDG  =  'SUBTOTAL  INTERSTATE'; 
MLGE.M  =  TOTALS; 
CALL  SDC  (MILEAGES); 
T0TALS1  =  TOTALS; 
TOTALS  =  0; 
END  PRINT_LINE; 


185:  FND  SURFTYP; 
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SUMMARY-BY -ROUTES  — 

Member  Name NBR 

Language PL/I 

Subroutines  PRINTXl 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  SUMMARY-BY-ROUTES  output 
ROADLOG  —  Road log  file 

Instruction 1  -   3  "NBR" 

6  "I"/"c"/"Pl7"S"/"A"  for  DATA=INT/ 
DATA=INT+PRIM/DATA=PRIM/DATA=SEC/ 
DATA=ALL 
40  -  43  Beginning  route  number 
56  -  59   Ending  route  number 

SUMMARY-BY-ROUTES  provides  a  summary  by  route  number  and  by  location  code. 
One  line  is  printed  for  each  route  in  the  route  system(s)  specified,  showing 
the  total  route,  constructed,  unimproved,  wye,  municipal,  county,  national 
forest,  Indian  reservation,  game  reserve,  state  forest,  national  park,  state 
park,  national  monument,  and  military  reservation  mileage  for  the  route. 
After  all  the  routes  in  a  system  have  been  printed,  the  total  values  for  the 
system  are  printed.   If  more  than  one  system  is  processed  (DATA=ALL  or  DATA= 
INT+PRIM  is  specified) ,  a  grand  total  is  printed  after  all  the  systems  have 
been  processed.   All  Roadlog  mileage  records  are  utilized  in  producing  the 
summary.   Mileage  which  falls  under  two  locations  (for  example,  municipal 
national  forest  mileage)  is  shown  in  both  categories.   "EN"  records  are 
utilized  for  detection  of  the  end  of  a  route,  causing  a  line  to  be  printed. 
All  records  other  than  "EN"  records  and  mileage  records  are  bypassed.   Three 
arrays  are  used  for  calculating  values.   The  array  M  is  used  for  calculating 
route  totals.   The  array  M_SYS_T0T  is  used  for  system  totals;  M  is  added  to 
M_SYS_T0T  each  time  the  end  of  a  route  is  detected  before  re-initializing  M 
to  zero.   The  array  M_T0T  is  used  for  calculating  grand  totals  when  DATA= 
INT+PRIM  or  DATA=ALL  is  specified;  M_SYS_T0T  is  added  to  M_T0T  after  printing 
the  system  totals  prior  to  re-initialization  of  M_SYS_T0T.   If  DATA=ALL  or 
DATA=SEC  is  specified,  the  end-of-file  condition  will  be  raised  on  the  Roadlog 
file  when  attempting  to  read  past  the  "EN"  record  of  the  last  Secondary  route. 
In  this  case,  the  end-of-file  condition  is  raised  and  the  character  "9"  is 
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placed  into  the  route  system  code  field  of  the  Roadlog  record,  causing  the 
program  to  think  that  a  new  route  system  has  been  encountered.   The  program 
will  print  the  system  totals,  and  the  grand  totals  if  required.   Since  "9" 
has  a  value  larger  than  "S,"  the  Roadlog  key  will  be  larger  than  "S999,"  and 
the  program  will  terminate  normally. 
The  NBR  program  listing  follows: 
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/*  :SUMMARY-BY-ROUTES,REPORT=ROADLOG,DATA=XXXXX  */ 

l:  /*  :SUMMARY-8Y-R0UTES,REP0RT=R0ADL0G,DATA=XXXXX  */ 


2: 
3: 
4: 
5: 
6: 
7: 

8: 

9: 

10: 

11: 

12: 


14 
15 
16 
17 
18 
19 
20 
21 
22 
23 

24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 
39 
40 
41 
42 
43 
44 
45 
46 
47 
48 

49 
50 
51 
52 


[ 


/* 


VALID  OATA  PARAMETERS: 
DATA=INT    (STARTKEY=I015,ENDKEY=I999,SYSTEM='I  •  ) 
DATA=INT+PRIM    (  ST  ARTKEY=  I  01  5  ,  ENDKE  Y  =  P999  ,  SYSTFM=  «  C  •  ) 
DAT A= PRIM    (STARTKEY=P001,ENDKEY=P999,SYSTEM='P« ) 
DATA=SEC     (  ST  APTKEY=S201,ENDKEY  =  S999,  SYSTEM'S' ) 
DATA=ALL     < ST AR TKE Y= 101 5, ENDKE Y= S999, SYSTEM= ' A • ) 


00  STATEMENTS 
SYSPRINT 
PRINTER 
RQADLOG 


UTILIZED: 


*/ 


13:  SUMRT:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 


/*  INSTRUCTION  AND  PRINT  SUBROUTINE  */ 

DECLARE 

PARM  CHARI 100) , 
(PRINTER, HEADING! 9) )  CHAR1132)  EXT, 
PRINTX  ENTRY  (PIC'Z' ) , 
SYSTEM  CHAR(l)  DEF  PARM  P0SI6), 
STARTKEY  CHAR(13)  DEF  PARM  P0SI40), 
ENDKEY  CHAR(13)  DEF  PARM  P0SI56), 
#_HDGS  PIC«Z»  DEF  INSTR  P0SI72), 
INSTR  CHAR(80)  EXT; 


/* 

DEC 
( 


STORAGE 

LARE 

M(  14),M. 


OF  MILEAGES  */ 


SY 


1   STRUCT 

2  (01, D 

DFC 
1   OUT  DEF 

3  RT_* 
2   MILEAG 

3  NET_ 
3  CONS 
3  UNIM 
3  WYE 
3  CITY 
3  COUN 
3  NFOR 
3  IRES 
3  GAME 
3  SFOP 
3  NPRK 
3  SPRK 
3  NMON 
3  MRFS 
UUT_DFSCR 
STRING  OUT 


S_TOT(  14) ,M_TOT(  14)  )  DEC  FIXED  (9,3), 
BASED  (PTR_STRCT), 

2,D3,D4,D5,D6,D7,08,D9,D10,D11,D12,D13,D14) 
FIXED  (9,3)  , 

STRING_OUT, 

PIC'ZZZZBB', 
F, 

ROUTE  PIC'ZZZZZV.ZZZBBBB' , 
TR  PIC'ZZZZZV.ZZZ' , 
P  PIC'ZZZZZV.ZZZ1 , 
PIC'ZZV.ZZZBB' , 

PIC'ZZZZV.ZZZ', 
TY    PIC'ZZZZZZV.ZZZ1  , 

PIC'ZZZZZV.ZZZ* , 

PIC'ZZZZZV.ZZZ* , 

PIC'ZZZZV.ZZZ', 

PIC'ZZZZV.ZZZ' , 

PIC'ZZZZV.ZZZ' , 

PIC'ZZZZV.ZZZ' , 

PIC  ZZZZV.ZZZ', 

PIC'ZZZZV.ZZZ'  , 
CHAR(6)  DEF  STRING_OUT, 

CHAR( 132)  STATIC; 


/*  ROADLOG  FILE  */ 
DECLARE 

1   RLG  BAStD  (PTR_RLG), 
3   DUM1  CHAR(  1) , 
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/*  :SUMMARY-BY-ROUTES,REPORT=ROADLOG,DATA=XXXXX  */ 


53 
54 
55 
56 
57 
58 
59 
60 
61 
62 
63 
64 


3   SYSTEM  CHAR( 1) t 

3   RT_#  PIC'ZZZ' , 
3  DUM2  CHAR(9I , 

3   REMARK  CHAR ( 2 > , 
3  (SECTN, ROUTE, CONST, UNIMP)DEC  FIXED<5,3), 

3  WYE  DEC  FIXED(3,3), 

3  DUM3  CHAR(61) , 

3  LOCN(2)  DEC  FIXED(3,0>, 
1   RLG2  BASED  (PTR.RLG), 

3   DUMl  CHAR(l), 

3   KEY  CHAR(13) , 
RQADLOG  FILE  RECORD  KEYED  INPUT  SEOL  ENV  (INDEXED) 


65 
66 
67 
68 
69 
70 
71 
72 
73 
74 
75 
76 
77 
78 
79 


/*  OTHER  VARIABLES  */ 

DECLARE 

B(5)  DEC  FIXED  (3,0)  STATIC 

BLANKS  CHAR(40)  STATIC  INIT 

CARRIAGE  PIC'Z', 

CARRIAGE1  CHAR(l)  DEF  CARRIAGE, 

LOCN_CODE( 10)  DEC  FIXED  (3,0)  STATIC 

(  1,2,3,4,5,9,8,10,7,6) , 
SAVE_SYS  CHAR( 1) , 


INIT  (35,23,24,36,38) , 

(  •  •  )  , 


INIT 


SYS 


5) 


CHAR  (50) 

■  FEDERAL 

■  FEDERAL 

•  FEDERAL 

•  FEDERAL 


STATIC  INIT  ( 
AID  INTERSTATE  SYSTEM', 
PRIMARY  SYSTEM  (LESS 


AID 
AID 

AID 


INTERSTATE) ' , 


—  ALL  FEDERAL 


PRIMARY  AND  INTERSTATE 
SECONDARY  SYSTEM' , 
AID  SYSTEMS' ) ; 


SYSTEMS', 


80:  /*****  INITIALIZATION  *****/ 


81 
82 
83 
84 
85 
86 
87 
88 
89 
90 
91 
92 
93 
94 
95 
96 
97 
98 
99 
100 
101 
102 
103 


CALL  INIT  (PARM); 
#_HDGS  =  8; 
IF  SYSTEM=« I •  THEN  I 
ELSE  IF  SYSTEM='P« 


ELSE 
ELSE 
ELSE 

ELSE 


IF 
IF 
IF 

DO 


SYSTFM='C 
SYSTEM='S' 
SYSTEM='A' 


=  l; 

THEN 
THEN 
THEN 
THEN 


2; 
3; 
4; 
5; 


GOTO 
END; 

HEADING( I) 
SYS(I ) ; 

HEADING(5) 


PRINTER  =  '*** 
CALL  PRINTX  (9) 
RETURN; 


INVALID  DATA  SPECIFICATION' 


=  SUBSTR(BLANKS,1,B( I ) )  I  I  'DETAIL  SUMMARY  BY  ROUTES'  II 

'  II 


•  NET 

i ********************************** 
•  ********************************** 


LOCATED  IN  '  | | 


HEADING(6) 

t 

•STATE 
HEADING(7) 
•   CITY 
•OREST 


a   I 


ROUTE 


ROUTE 

NATIONAL 

NATL   STATE    NATL 

=  •  NO.     MILEAGE 

COUNTY    FOREST 

PARKS   PARKS     MON 


STATUS 
,   •  II 


**  DEVELOPMENT 
INDIAN     GAME 
MILIT'  ; 

CONSTR    UNI  MP   WYE 
RESERVE    REFUGE   F'  || 
RESERVE' ; 


** 


II 


104:     /*  INIT  VAR  */ 

105:     M,  M_SYS_TOT,  M_TOT  =  0; 
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/*     :SUMMARY-BY-ROUTES,REPORT=ROADLGG,DATA=XXXXX    */ 


I 


106:  CARRIAGE1  =  •!•; 

107:  STRING_0UT  =  '  ■ ; 

108:  /*  INIT  ROADLOG  FILE  */                                              I 

109:  OPEN  FILE  (ROADLOG);                                                *~ 

110:  ON  ENOFILE  (ROADLOG)  RLG. SYSTEM  =  ■ 9«  ; 

111:  READ  FILE  (ROADLOG)  SET  <PTR_RLG)  KEY  (STARTKEY),                   r- 

112:  /*****  EXECUTION  LOOP  *****/                                           r- 

HA:  IF  RLG.REMARK='EN«  THEN  GOTO  END_OF_ROUTE ;               , 

115:  IF  RLG. REMARKS   •  I  RLG .REMARK=' SP '  I  RLG. REMARK-  LP   I 

116:  RLG.REMARK='NE«     I     RLG. REMARK= ' OS •                                                                                     U 

117:  THEN    GOTO    M IL E AGE_RECORD; 


[ 
[ 
[ 


129:  END; 

130:  END; 

•  -»i.  mm    Dc/in   cnAni  nr,    ^F-rriRn:  f 


118:    READ_RnADLOG_RECORD: 

119:  READ    FILE    (ROADLOG)     SET    (PTR_RLG); 

120:  GOTO    LOOP; 

121:    MILFAGE.RECORD: 

122:  M(l)    =    M(i)     +    RLG. ROUTE; 

123:  M(2)    =    M(?)     +    RLG. CONST; 

124:  M(3)    =    M(3)     ♦    RLG.UNIMP; 

125:  M(4)    =    M(4)     «■    RLG. WYE; 

126:  DO    1=1    TO    2; 

\\V:  D°    IfYlG.LOCNU^LOCN.COOEU.     THEN    M<J+4I     -    M<J+4>     ♦    RLG. SEC 

129:  END; 

130:  END; 

131:  GOTO    READ_ROADLOG_RECORD; 

132:  END_OF_ROUTE: 

133:  /*  PRINT  M  */ 

134:  OUT.RT_#  =  RLG.RT_#;  , 

135:     PTR_STRCT  =  ADDR(M); 

136:  OUT. MILEAGE  =  STRUCT;  h 

137:     PRINTER  =  STRING_OUT; 

138:     CALL  PRINTX  (CARRIAGE); 

139:     CARRI AGE1  =  ' I*  5  k 

140:     /*  ADD  ROUTE  TOTALS  TO  SYSTEM  TOTALS  */  . 

141 :     M_SYS_TOT  =  M_SYS_TOT  +  M;  [ 

142:     M  =  0; 

143:     /*  END  OF  ROUTE  SYSTEM?  */ 

144:     SAVE.SYS  =  RLG. SYSTEM;  k 

145:  READ    FILE     (ROADLOG)     SET     (PTR.RLG); 

146:  IF    RLG.SYSTEM=SAVE_SYS    THEN    GOTO    LOOP; 

147:  /*    ADD    SYSTEM    TOTALS    TO    GRAND    TOTALS    */ 

148:  M_TOT    =    M_TOT    ♦    M_SYS_TOT;  . 

149:  /*     PRINT    M_SYS_TQT     */ 

150:  IF     M_T0T(1)-=M_SYS_T0T(1)     I     RLG2 .K EY<= ENDKE Y    THEN    DO; 

151:  PRINTER    =     'SUBTOTAL' ; 
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/*  :SUMMARY-BY-ROUTES,REPORT-ROADLOG,DATA=XXXXX  */ 


152 
153 
154 
155 
156 
157 
158 
159 
160 
161 
162 
163 
164 
165 


CALL  PRINTX  (2); 

OUT_DESCR  =  •  •  ; 

CARRIAGE1  =  »1«; 

END; 
ELSE  DO; 

OUT.DESCR  =  'TOTAL*; 

CARRIAGE1  =  '2'; 

END; 
PTR_STRCT  =  ADDR(M_SYS_TOT) 
PRINT: 

OUT. MILEAGE  =  STRUCT; 
PRINTER  =  STRING_OUT; 
CALL  PRINTX  (CARRIAGE); 
CARRIAGE  =  3; 


166:  /*  MORE  PROCESSING  REQUIRED?  */ 

167:  IF  RLG2.KEY<=ENDKEY  THEN  DO; 

168:  M_SYS_TOT  =  0; 

169:  GOTO  READ_ROADLOG_RECORD; 

170:  END; 

171:  /*  MORE  THAN  ONE  SYSTEM  PROCESSED?  */ 

172:  IF  OUT_DESCR-.=  ,TOTAL»  THEN  DO; 

173:  OUT_DESCR  =  'TOTAL'; 

174:  PTR_STRCT  -  ADDR(M_TOT); 

175:  GOTO  PRINT; 

176:  END; 

177:  CLOSE  FILE  (ROADLOG); 

178:  RETURN: 

179:  CALL  EXIT  (PARM); 

180:  END  SUMRT; 
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SUMMARY-BY-LOCAT ION  —  SUMMARY-BY -LOCATION  consists  of  three  separate 
programs:   one  for  DATA=INT ,  one  for  DATA=INT+PRIM ,  and  one  for  DATA=SEC. 
The  member  names  for  the  three  are  NCRI,  NCRC  and  NCRS,  respectively.   The 
command  decoder  cannot  set  up  the  member  name  for  inclusion  in  the  instruction; 
the  supervisor  itself  fills  in  the  fourth  character  from  the  data  parameter. 

DATA=INT : 

Member  Name NCRI 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  SUMMARY-BY-LOCAT ION  output 
ROADLOG  —  Roadlog  file 

Instruction 1  -  4  "NCRI" 

NCRI  prints  the  SUMMARY-BY-LOCAT ION  for  the  Interstate  system. 
This  summary  is  based  on  route  mileage,  rather  than  constructed 
mileage  (as  are  most  of  the  Roadlog  summaries).   All  mileage 
records  in  the  Interstate  system  are  used  in  producing  the 
summary  (the  program  checks  for  non-zero  route  length  rather 
than  for  remark  codes) .   All  Interstate  mileage  falls  into  five 
categories:  municipal,  county,  national  forest,  Indian  reserva- 
tion, and  game  refuge.   Municipal  and  county  mileage  is  outside 
federal  reservations;  the  other  three  are  inside.   For  each 
route  is  shown  the  total  values  in  each  of  the  five  categories, 
as  well  as  the  total  mileage  outside  federal  reservations,  inside 
federal  reservations,  and  grand  total.   Totals  for  a  route  are 
accumulated  in  array  STORE  in  structure  NUM1.   The  8  subscripts 
of  STORE  are  used  as: 


1  Municipal 

2  County 

3  Total  outside  Federal  reservations 

4  National  Forest 

5  Indian  Reservation 

6  Game  refuge 

7  Total  inside  Federal  reservations 

8  Grand  total 
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Mileage  falling  into  two  categories  is  shown  in  the  category 
falling  inside  a  federal  reservation.   The  Interstate  system 
totals  are  accumulated  in  array  TOTALS  in  structure  NUM2.   TOTALS 
is  subscripted  identically  to  STORE. 

The  NCRI  program  listing  follows : 
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/*  :SUMMARY_BY_LOCATION,REPORT=ROADLOG,DATA=INT  */ 


1 

2 

3 

4 

5 

6 

7 

8 

9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 

21 

22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 
40 
41 
42 
43 
44 
45 
46 
47 
48 
49 
50 
51 
52 
53 
54 
55 
56 
57 


/*  :SUMMARY_BY_L0CATI0N,REP0RT=P0AUL0G,DATA=INT  */ 
SUMLOC:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 

/**  FILE  FOR  ROADLOG  INPUT  **/ 

DCL  ROADLOG  FILE  RECORD  INPUT  SEGL  KEYED  ENV( INDEXED ) ? 
/**  FOR  PRINTING  OUTPUT  **/ 
DCL  HEADING(9)  CHAR(132)  EXT, 

INSTR  CHAR(80)  EXT, 
#_HDGS  PIC1!1    DEF  INSTR  P0S(72), 

F(0:9)  PIC'Z'  STATIC  INI  T  (  0  ,  1,  2  ,  3  ,4,  5  ,6  ,  7  ,  8,  9  )  , 
PRINTER  CHAR(132)  EXT, 

BLANKS  CHAR(132)  STATIC  IN  I T  ('  •); 
/**  FOR  INPUT  OF  ROADLOG  VARIABLES  **/ 
DCL  1  RLG  STATIC, 

5  DUMMY1  CHAR( 1) , 

5  KEY, 

10  SYSTEM         CHAR( 1) , 
10  RT_#  PIC'999' , 

10  MILEPOST  CHAR(9) , 
5  REMARK  CHAR ( 2 ) , 
5  (DUM1 ,RQUTE)DFC  FIXED(5,3), 
5  DUMMY2  CHARI69) , 
5  L0CN(2)  DEC  FIXEC(3,0), 
5  DUMMY3  CHAR(25); 

/**  FOR  OUTPUT  OF  INTERSTATE  MILEAGE  TOTALS  PER  ROUTF  **/ 
DCL  1  NUM1  STATIC, 

5  RT_#  PIC'ZZZZZZ1, 

5  ST0RE(8)  PIC'ZZZZZV.ZZZ • ; 

DCL  STRING.NUM1  CHAR(78)  DEF  NUM1, 
STRING_NUM2  CHAR(78)  DEF  NUM2; 
/**  FOR  OUTPUT  OF  COLUMN  TOTALS  **/ 
DCL  1  NUM2  STATIC, 

5  REMARK  CHAR(6)  INIT<«  TOTAL'), 

5  T0TAL<8)  PIC'ZZZZZV.ZZZ'; 

/**  LOCATION  CODES  USED  IN  VARIABLE  LOCN  IN  RLG  **/ 
DCL  L0CATI0N_C0DE(6)  DEC  FIXED(3,0)  STATIC  IN  I T(  1 , 2 , o f 3 ,4  ,  5)  ; 
/**  BEGINNING  KEY  OF  FAI  RECORDS  **/ 
DCL  KEY  CHARI13)  STATIC  INIT  (' I  0  15000  +  0. 000 •)  ; 

DCL  PARM  CHAR( 100) ; 
CALL  INIT  (PARM); 

/**  SET  UP  PAGE  HEADINGS  **/ 

HEADING! 1)  =  SUBSTR( BLANKS, 1,37)  ||  'SUMMARY   OF   ROUTF   »  I  I 

'LENGTHS   AND   LOCATIONS'; 
HEADING(2)=SUBSTR(BLANKS, 1,43)  ||  'FEDERAL   AID   INTERSTATE 

•   SYSTEM'; 
SUBSTR(HEADING(4),21)  =  '  OUTSIDE  FEDERAL  RESERV.' 

•***  INSIDE  FFDERAL  RESERVATIONS  ***•; 
SUBSTP(HEADING(6),21)='    ROUTE  • 

•NATIONAL    INDIAN     GAME  GRAND'; 

SUBSTR(HEADING(7 ), 21)='     NO.    MUNIC    COUNTY     TOTAL  ' 

•  FOREST    RESERV.    REFUGE     TOTAL    TOTAL'; 
#_HDGS=8; 

OPEN  FILE  (ROADLOG)  INPUT  TITLE  ('ROADLOG'); 
/**  INITIALIZE  INTERNAL  VARIABLES  **/ 
STORE=0;   TOTAL=0; 
/**  READ  FIRST  FAI  RECORD  **/ 

-122- 


f* 

58 

59 

60 

61 

62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 

80 

81 

82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 

100 

101 

102 

103 

104 

105 

106 

107 

108 

109 

110 

111 

112 

113 

114 

115 


:SUMMARY_BY_LOCAT ION, RE P0RT=RGADL0G, DATA= INT    */ 

READ  FILE  (ROADLOGJ  INTO  (RLG)  KEY  (KEY); 
GO  TO  CHECK; 


/**  MAIN  EXECUTION  LOOP  **/ 

/**  CONTINUE  READING  FA  I  RECORDS  **/ 
CONT:    READ  FILE  (ROADLOG)  INTO  (RLG); 

/**  AFTER  LAST  ROUTE,  OUTPUT  COLUMN  TOTALS  **/ 

IF  SYSTEM-***  I »  THEN  GO  TO  0UTPUT_2; 

/**  OUTPUT  MILEAGES  AT  END  OF  EACH  ROUTE  **/ 

IF  RLG.REMARK=«EN«  THEN  GO  TO  0UTPUT_1 ; 

/**  IGNORE  DESCRIPTION  AND  COINCIDENT  TYPE  RECORDS  **/ 
CHECK:   IF  RLG.ROUTE-=0  THEN  GOTO  SORT; 

GO  TO  CONT; 

/**  OUTPUT.!  PRINTS  MILEAGE  TOTALS  FOR  A  SINGLE  ROUTE  **/ 

/**  CALCULATE  NECESSARY  SUBTOTALS  AND  TOTALS  **/ 
OUTPUT_l:  ST0RE<3)  =  STORE(l)  ♦  ST0RE<2); 
DO  I  =  4  TO  6; 

ST0RFI7)  =  ST0REC7)  ♦  STORE  (  I  )  *, 

END; 
ST0RE(8>  =  ST0RE(3)  +  ST0RE<7); 
/**  PRINT  ROUTE  MILEAGE  **/ 
NUM1.RT_MRLG.KEY.RT_*; 

PRINTER  =  SUBSTR(BLANKS, 1,20)  I  I  STRING_NUM1; 
CALL  PRINTX  (F(l»); 

/**  STORE  ROUTE  MILEAGES  FOR  SYSTEM  TOTALS  **/ 
DC  I  =  1  TO  8; 

TOTAL(I)  =  TOTAL(I)  +  STORE! I  I; 

END; 
/**  SET  ROUTE  MILEAGES  TO  ZERO  AT  START  OF  EACH  NEW  ROUTE  **/ 
STORE=0; 
GO  TO  CONT; 

/**  0UTPUT_2  PRINTS  COLUMN  TOTALS  **/ 
0UTPUT.2:   PRINTER  =  SUBSTR { BLANKS , 1 , 20)  ||  STRING_NUM2; 
CALL  PRINTX  (F(2)); 
GO  TO  CLOSE; 


/**  THE  SORT  ROUTINE  DETERMINES  THE  TYPE  OF  MILEAGE  IN  A 

PARTICULAR  RECORD  AND  STORES  THE  MILEAGE  IN  AN  ARRAY  **/ 
/**  SINGLE  OR  DUAL  MILEAGE  CLASSIFICATION  RECORD  **/ 


SORT 


IF  LOCN(l)-=0  I    L0CN(2)-=0  THEN  GOTO  SI; 
/**  SORT  SINGLE  CLASSIFICATION  RECORDS**/ 
DO  I  =  1,2,4  TO  6; 

IF  LOCN(l)  =  LOCATION_CODE( I )  THEN  DO; 
/**  STORE  DETECTED  MILEAGE  TYPE  **/ 
STORE(I)  =  STORE(I)  +  ROUTE; 
END; 
END; 
GOTO  CONT; 

/**  SORT  DUAL  CLASSIFICATION  RECORDS  **/ 
Si:      DO  I  =  4  TO  6; 
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/*  :SUMMARY_BY_LOCATION,REPORT=ROADLOG,DATA=INT  */  t- 

116:  IF  L0CN<2)  =  LOCAT ION_CODE < I )  THEN  DO; 

117:  STORE(I)  =  STORE(I)  +  ROUTE;                             [_ 

118:  END; 

119:  end;                                               r 

120:  GOTO  CONT ;                                                   [_ 

121: 

122 : 

123:  CLOSE:   CLOSE  FILE  (ROADLOG); 

124:  CALL  EXIT  (PARM)  ;                                              t- 

125:  END  SUMLOC; 
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DATA=INT+PRIM: 


Member  Name NCRC 

Language PL/ 1 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  SUMMARY-BY-LOCATION  output 
ROADLOG  —  Road log  file 

Instruction 1  -  4   "NCRC" 


NCRC  prints  the  SUMMARY-BY -LOCATION  when  DATA=INT+PRIM  is 
specified.   This  summary  is  based  on  constructed  length, 
rather  than  on  route  length.   The  summary  must  also  compute 
and  print  the  status  of  the  7%  system  (consisting  of  Inter- 
state and  Primary  mileage  outside  Federal  reservations  which 
is  neither  urban  nor  Interstate  loop  mileage) .   Mileage  in 
the  Interstate  and  Primary  systems  falls  into  seven  categories : 
municipal,  county,  National  Forest,  Indian  Reservation,  state 
forest,  National  park,  and  game  refuge  mileage.   Municipal, 
county,  and  state  forest  mileage  is  outside  Federal  reservations 
Values  for  each  route  are  accumulated  in  12-element  array 
STORE  in  structure  NUM1.   The  subscript  usage  is: 


1  Municipal 

2  County 

3  State  Forest 

4  Totals  —1  +  24-3 

5  Urban  Extensions 

6  Totals  —  4-5 

7  National  Forest 

8  Indian  Reservation 

9  National  Parks 

10  Game  Refuge 

11  Totals   —7+8+9+10 

12  Totals  —4+11 


Out-of-state  mileage  records  (remark  "OS")  are  not  included 

in  the  summary.   Mileage  falling  into  two  categories  is  included 

in  the  category  falling  inside  a  federal  reservation  (thus 
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removing  it  from  the  7%  system) .   "IL"  records  in  the  Primary 
system  defining  Interstate  loops  are  processed  to  find  non- 
urban  Interstate  loop  mileage.   All  such  mileage  is  added  into 
variable  LOOP_MI  for  use  when  calculating  the  7%  system  status. 
Array  TOTAL  in  structure  NUM3  is  used  for  calculating  system 
totals.   Like  STORE,  TOTAL  has  12  subscripts,  used  as  in  STORE. 
The  7%  system  is  calculated  by  taking  the  total  mileage  (column 
4  of  the  summary)  outside  federal  reservations,  and  subtracting 
the  urban  extensions  (column  5)  and  non-urban  Interstate  loops 
(in  LOOP_MI) .   The  result  is  compared  to  the  permissible  value 
of  4697.0  miles,  and  any  overrun  or  underrun  printed. 
The  NCRC  program  listing  follows : 
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/*  :SUMMARY_BY_LOCATION,REPORT=ROADLOG,DATA=INT*PRIM  */ 

l:  /*  :SUMMARY_BY_LOCATION,REPORT=ROADLOG,DATA=INT+PRIM  */ 
SUMLOC:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 


2 
3 
4 
5 
6 
7 
8 
9 
10 
11 
12 
13 
14 
15 
16 
IT 
18 
19 
20 
21 
22 
23 
24 
25 
26 
2T 
28 
29 
30 
31 
32 
33 
34 
35 
36 
3T 
38 
39 
40 
41 
42 
43 
44 
45 
46 
4T 
48 
49 
50 
51 
52 
53 
54 
55 
56 
5T 


/**  EILE  FOR  ROADLOG  DATA  INPUT  **/ 

DCL  ROADLOG  FILE  RECORD  INPUT  SEOL  KEYED  ENV( INDE XED )  ; 

/**  FOR  PRINTING  OUTPUT  **/ 

DCL  HEADINGI9)  CHAR(132)  EXT, 

INSTR  CHAR(80)  EXT, 

PARM  CHAR(IOO), 

#_HDGS  PIC«Z»  DEF  INSTR  P0S(72), 

#_LINES  PIC'ZZ1, 

F(0:9)  PIC^Z*  STATIC  INIT  (0,1,2,3,4,5,6,7,8,9), 

PRINTER  CHAR(132)  EXT, 

BLANKS  CHAR(132)  INIT(«  •); 

/**  FOR  INPUT  OF  ROADLOG  VARIABLES  **/ 
DCL  1  RLG  STATIC, 

5  DUMMY1  CHAR( 1), 

5  KEY, 

10  SYSTEM         CHAR( 1), 

io  rt_#         Pic^gg* , 

10  MILEPOST  CHAR(9), 
5  REMARK  CHAR(2), 
5  SECTN  DEC  FIXED(5,3), 
5  DUMMY2  CHAR(9>, 
5  WYE  DEC  FIXED(3,3), 
5  DESCR  CHAR (35), 
5  DUMMY3  CHAR( 13) , 

5  POPULATION_CODE  OEC  FIXED!  1,0), 
5  DUMMY4  CHAR( 12) , 
5  L0CN(2)  DEC  FIXED(3,0), 
5  DUMMY5  CHAR(25) ; 

/**  FOR  OUTPUT  OF  MILEAGE  TOTALS  PER  ROUTE  **/ 
DCL  1  NUM1  STATIC, 

5  DUMMY1  CHAR(13)  INITC  •), 

5  RT_#  PIC'ZZ*, 

5  ST0RE(12)  PIC^ZZZZV.ZZZ1  ; 

/**  FOR  OUTPUT  OF  COLUMN  TOTALS  **/ 
DCL  1  NUM3  STATIC, 

5  REMARK  CHARI15)  INIT(«       INTERSTATE1) 

5  T0TAL(12)  PIC^ZZZZZV.ZZZ* ; 

/**  FOR  DETERMINING  NET  7%    SYSTEM  MILEAGE  **/ 
DCL  1  NUM2  STATIC, 

5  REMARM2)  CHARI42), 

5  MILEAGE  PIC • Z ZZZ ZZV. ZZZ • ; 

/**  FOR  1%    SYSTEM  SUMMARY  OUTPUT  **/ 
DCL  1  NUM4  STATIC, 

5  REMARM2)         CHAR(42), 
5  MILEAGE  PIC • Z ZZZ ZZV. Z • ; 

/**  FOR  ACCUMULATING  TOTAL  SYSTEM  AND  LOOP  MILEAGES  **/ 
DCL  LOOP.MI  PIC'ZZZVZZZ' , 

T0TAL_MI(12)  PIC'ZZZZZVZZZ1; 

/**  LOCATION  CODES  USED  IN  VARIABLE  LOCN  IN  RLG  **/ 
DCL  L0CATION_CODE (10)  DEC  FIXED(3,0)  STATIC  INIT 
(1,2,9,0,0,0,3,4,8,5); 
/**  KEYS  FOR  INTERSTATE  RECORD  SEARCHING  **/ 
DCL  SAVE.KEY  CHAR(13), 
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/*     :SUMMARY_BY_LOCATION,REPORT=ROADLOG,DATA=INT+PRlM    */ 

53:  LOOP_ENDKEY    CHAR(13); 

59: 

60:  /**  PROGRAM  INITIALIZATION  **/ 
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: 


ON  ERROR  BEGIN; 

PRINTER  =  •***  ERROR  IN  SUMMARY_BY_LOCATI ON  ROUTINE*;  ^ 

CALL  PRINTX  (F(3)); 
GOTO  CLOSE; 
END; 

CALL  INIT  (PARM) ; 

/**  SET  UP  PAGE  HEADINGS  **/ 
HEADING(1)=SUBSTR(BLANKS,1,40)| I'SUMMARY   OF   ROUTE   LE«  II 

•NGTHS   AND   LOCATIONS';  * 

SUBSTR(HEA0ING(2),41,44)  = 

•FEDERAL  AID  PRIMARY  AND  INTERSTATE  SYSTEMS'; 
HEADING(4)  =  •  ******LOCATED  OUTSIDE  FEDE1  ^ 

•RAL  RESERVATIONS******       **LOCATED  INSIDE  FEDERAL  R' 
•ESERVATIONS**' ; 
HEADING(6)=SUBSTR(BLANKS,1,54) | | •LESS* ; 

HEADING(7>  =  ■  ROUTE  STATE    •' 

•   SUB     URBAN  NAT.     INDIAN      NAT.    »|l 

•  GAME  GRAND1; 
HEADING(8)  =  •  NO.    MUNIC    COUNTY    FOREST    ' 

•  TOTAL   EXTENT.     TOTAL    FOREST   RESERV.     PARKS    • 
•REFUGE     TOTAL    TOTAL1; 

#_HDGS  =  9; 

OPEN  FILE  (ROADLOG)  INPUT  TITLE  («ROADLOG'); 
/**  INITIALIZE  INTERNAL  VARIABLES  **/ 
TOTAL_MI=0;   TOTAL, STORE=0; 
LOOP_MI=0; 

/**  READ  FIRST  RECORD  **/ 
READ  FILE  (ROADLOG)  INTO  (RLG)  KEY  (•I0151); 
GO  TO  CHECK  1; 


/**  MAIN  EXECUTION  LOOP  **/ 

/**  CONTINUE  READING  RECORDS  **/ 
CONTl:   READ  FILE  (ROADLOG)  INTO  (RLG); 

/**  INTERSTATE  LOOP  MILEAGE?  **/ 

IF  RLG.REMARK=« IL'  THEN  GO  TO  INTERSTATE_LOQPS; 

/**  OUTPUT  TOTALS  AT  END  OF  EACH  ROUTE  **/ 

IF  RLG.REMARK='EN»  THEN  GO  TO  0UTPUT1; 

/**  AFTER  LAST  PRIMARY  ROUTE,  OUTPUT  TOTALS  AND  1%    STATUS  **/ 

IF  RLG.KEY.SYSTEM='S«  THEN  GO  TO  0UTPUT2; 

/**  IGNORE  DESCRIPTION  AND  COINCIDENT  TYPE  RECORDS  **/ 
CHECKl:  IF  RLG.REMARK=«   •  |  RLG .KEMARK= ' SP •  |  RLG. REMARK= »LP •  I 
RLG.REMARK=«NE'  THEN  CALL  SORT; 

GO  TO  CONTl; 

/**  SEARCHES  FOR  AND  CUMULATES  INTERSTATE  LOOP  MILEAGE  **/ 
INTERSTATE_LOOPS: 

/**  RETAIN  CURRENT  PRIMARY  SYSTEM  KEY  **/ 

SAVE_KEY=STRING(RLG.KEY) ; 

/**  DETERMINE  ENDING  KEY  FOR  LOOP  RECOROS  **/ 

LOOP.ENDKEY  =  SU BSTR ( RLG.DESCR ,6, 4)  II  SUBSTR ( RLG.DESCR , 26, 9 ) 

/**  BEGIN  READING  LOOP  RECORDS  **/ 
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/*  :SUMMARY_BY_LOCATION, REPORT=ROADLOGf DAT A=INT+PR IM  */ 

READ  FILE  (ROAOLOG)  INTO  (RLG)  KEY  ( SUBSTR ( RLG. DE SCP , 6 ,4 )  II 
SUBSTR(RLG.DFSCR,16, 9) ) ; 
CHECK2:  IF  RLG. REMARK-='   •  £  RLG.REMARK-.=  ' SP*  £  RLG.REMARK-»=  •  LP  •  £ 
RLG.REMARK-.=  'OS'  £  RLG.  REMARK-=  •  NE  •  THEN  GO  TO  CONT2; 
/**  MILEAGE  OUTSIDE  FEDERAL  RESERVATIONS?  **/ 
IF  LOCN(l)=l  £  LOCN(2)=0  |  LOCN(l)=l  £  L0CN(2)=9  I 

LOCN(l)=2  £  LOCN(2)=0  |  L0CN(1)=9  £  LOCN(2)=0  THEN  DO; 

/**  MILEAGE  NOT  ALREADY  COUNTEO  AS  AN  URBAN  EXTENSION?  */ 
IF  POPULATION_CODE  <  4  THEN  DO; 
LOOP_MI  =  LOOP_MI  +  SECTN; 
END; 
END; 
/**  CONTINUE  READING  LOOP  MILEAGE  RECORDS  **/ 
CONT2:   READ  FILE  (ROADLOG)  INTO  (RLG); 

IF  LOOP.ENDKEY  >  STR I NG< RLG. KEY )  THEN  GO  TO  CHECK2; 
/**  RETURN  TO  PRIMARY  SYSTEM  RECORDS  **/ 
RFTURN:  READ  FILE  (ROADLOG)  INTO  (RLG)  KEY  (SAVE_KEY); 
GO  TO  CONTl; 


OUTPUT1 


/**  OUTPUTl  PRINTS  TOTALS  PER  ROUTE  AND  SYSTEM  SUBTOTALS  **/ 

ST0RE(4)  =  STORE(l)  ♦  STORE(2)  +  STOREO); 
ST0RE(6)  =  ST0RE(4)  -  STORE(5); 

STORE(ll)  =  STORE(7)  ♦  STORE(8)  ♦  ST0RE(9)  ♦  STORF(IO); 
STORE(12)  =  ST0RE(4)  ♦  STORE(ll); 
/**  PRINT  ROUTE  MILEAGE  **/ 
NUM1.PT_#  =  RLG.KEY.RT_#; 
PRINTER=STRING(NUM1) ; 
CALL  PRINTX  (F(1M; 
/**  STORE  ROUTE  MILEAGES  FOR  SYSTEM  SUBTOTALS  **/ 
DO  I  =  I  TO  12; 

TOTAL(I)  =  TOTAL(  I  )  +  STORE ( I  )  ; 

END; 
/**  PRINT  SUBTOTALS  WHEN  NECESSARY  **/ 
IF  RLG.KEY.RT_#  =  094  |  RLG.KEY.RT_#  =  054  THEN  DO; 

PRINTER  =  •         SUBTOTAL1 ; 
CALL  PRINTX  (F(l)); 

IF  RLG. KEY. SYSTEM  =  «P'  THEN  NUM3. REMARK  =•  PRIMARY'; 

PRINTER  =  STRING(NUM3) ; 
CALL  PRINTX  (F(l)); 

PRINTER  =  '  • ; 
CALL  PRINTX  (F(D); 

/**  STORE  MILEAGES  FOR  1%    SYSTEM  TOTALS  **/ 

DO  I  =  1  TO  12; 

TOTAL_MI(I)  =  TOTAL_MI(I)  ♦  TOTAL! I )  ; 
END; 

TOTAL=0; 

END; 
STORE=0; 
GO  TO  CONTl; 


/**  0UTPUT2  PRINTS  TOTALS  AND  STATUS  OF  THE  1%    SYSTEM  **/ 
OUT  PUT 2: 

PRINTER  =  'NET  CONSTRUCTED'; 

CALL  PRINTX  <F(1)); 

NUM3. REMARK  =  •  LENGTH'; 
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/*  :SUMMARY_BY_LOCATION,REPORT=ROADLOG,DATA=INT-»-PRIM  */ 
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r, 


1  I 


TOTAL  =  TOTAL_MT; 
PRINTER  =  STRTNG(NUM3); 
CALL  PRINTX  <F<1)); 

/**  OUTPUTS  STATUS  OF  7%    SYSTEM  MILEAGE  **/ 

HEA0ING(4)=»  «;   #_HDGS=5;   #_LINES=15;  ' 

PRINTER=SUBSTR(BLANKS,1,38)  11  *****************************  I 
i ********************* • ; 

CALL  PRINTXA  ( F ( 8) , #_L  INES )  ♦ 

PRINTER=SUBSTR(BLANKS,1»34)  I  I  **********  STATUS   OF   THE   »  «7 

*7%      SYSTEM   MILEAGE  *********•;  J 

CALL  PRINTX  IFdll; 
PRINTER=SUBSTR(BLANKS,1,38>  I!  •***************************' c-, 

«  ********************** ; 

CALL    PRINTX    (F(D); 

NUM2.REMARKUI    =    •  TOTAL    7%    S« 

NUM2.REMARK(2)    =    'YSTEM    MILEAGE    OUTSIDE    FEDERAL    RESERVATIONS'*; 
NUM2. MILEAGE   -    T0TAH4J; 

PRINTER    =    STRING(NUM2) ; 
CALL    PRINTX     (F<3)); 
NUM2.PEMARM1)    =    ■     •; 

NUM2.REMARM2)    =    •  LESS    URBAN    EXTENSION    MILEAGE' 

NUM2. MILEAGE    =    T0TAL15); 

PRINTER    -    STRINGCNUM2); 
CALL    PRINTX     (FUJI; 

NUM2.REMARM2)    =    ■  LESS    NON-URBAN    INTERSTATE    LOOP    MILEAGE';^ 

NUM2. MILEAGE    =    LOOP.MI; 

PRINTER  =  STRINGCNUM2); 
CALL  PRINTX  (F<1)); 

NUM2.REMARKU)  =  •  ACTUAL  7%    SV 

NUM2.REMARKI2)  =  'YSTEM  MILEAGE  OUTSIDE  FEDERAL  RESERVATIONS'; 
NUM2. MILEAGE  =  T0TAH4)  -  T0TALC5)  -  LOOP_MI ; 

PRINTER  =  STRING(NUM2)  ;  [. 

CALL  PRINTX  <F(1)); 

NUM4.REMARKU)  =  ■  PERMISSIBLE  7%    S«-t 

NUM4.REMARK(2)  =  'YSTEM  MILEAGE  OUTSIDE  FEDERAL  RESERVATIONS' 
NUM4. MILEAGE  =  4697.0; 

PRINTER  =  STPING(NUM4); 
CALL  PRINTX  (F<3>); 

NUM4.REMARKQ)  =  '  ACTUAL  7%    S', 

NUM4. MILEAGE  =  ROUND( NUM2. MILEAGE , 1 ) ; 

PRINTER  =  STR INGCNUM4); 
CALL  PRINTX  (Ffllt; 
NUM4.REMARM1)  =  •  •; 
IF  NUM4.MILEAGE>=4697.0  THEN  DO; 

NUM4.REMARK(2)='        OVERRUN  IN  ACTUAL  7*  SYSTEM  MILEAGE 

NUM4. MILEAGE  =  ROUND ( NUM2.M ILE AGE, 1 )  -  4697.0; 

END; 

ELSE  DO; 

NUM4.REMARK(2)='       UNDERRUN  IN  ACTUAL  7%    SYSTEM  MILEAGE, 
NUM4. MILEAGE  =  4697.0  -  ROUND (NUM2. MIL E AGE , 1  )  ; 
END; 
PRINTER  =  STRINGINUM4); 
CALL  PRINTX  <F(1)); 
GO  TO  CLOSE; 

/**  THE  SORT  ROUTINES  DETERMINE  THE  TYPE  OF  MILEAGE  IN  A 

PARTICULAR  RECORD  AND  STORE  THE  MILEAGES  IN  ARRAYS  **/ 
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/*  :SUMMARY_BY_LOCATION,REPORT=ROADLOG,DATA=INT*PRIM  */ 
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SORT 


SI 


S2 


IF 


CLOSE: 


PROC; 

/**  SINGLE  OR  OU 
IF  LOCN(  l)-.=0  I 
/**    SORT  SINGLE 
DO  I  =  1  TO  3,7 
IF  LOCN(l)  = 
/**  STORE 
STORE(I)  = 
END; 
END; 
GO  TO  S2; 
/**  SORT  DU 
DO  I  =  3,7 
IF  LOCN( 
STORE 
END; 
END; 
/**  CHECK  ALL  RE 
L0CN(1)=1  £(LOCN 
L0CN(2)=0   | 
IF  POPULAT 
ST0RE(5 

end; 

END; 
END  SORT; 


CLOSE  FILE  <ROADLOG); 
CALL  EXIT  (PARM); 


AL  MILEAGE  CLASSIFICATION  RECORD  **/ 
LOCNC2)-.=  0  THEN  GOTO  SI; 
CLASSIFICATION  RECORDS  **/ 
TO  10; 

L0CATION_CODE(Il  THEN  DO; 
DETECTED  MILEAGE  TYPE  **/ 
STORE( II  +  SECTN; 


AL  CLASSIFICATION  RECORDS  **/ 
TO  10; 
2)  = 
(I)  = 


LOCATION.CODEd)  THEN  DO; 
STORE( I )  +  SECTN; 


CORDS  FOR  URBAN  EXTENSIONS  **/ 
(2)=0|L0CN(2)=9> |LOCN< l)=2  6 
L0CN(1)=9  a  L0CN(2)=0  THEN  DO; 
I0N_C00E>=4  THEN  DO; 
)  ■  ST0RE(5)  +  SECTN; 


260:  END  SUMLOC; 
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************#***#*»***#***#**************#**************♦♦*******************< 


DATA=SEC : 


Member  Name NCRS 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  SUMMARY-BY -LOCATION  output 
ROADLOG  —  Road log  file 

Instruction 1  -  4  "NCRS" 


NCRS  operates  in  a  similar  fashion  to  NCRI,  excepting  that  ■ 

more  categories  exist.   NCRS  uses  route  mileage  in  its  com- 
putations.  The  subscripts  of  STORE  and  TOTAL  have  the  m 
following  meanings  in  NCRS : 


1  Municipal 

2  County 

3  State  Forest 

4  State  Park 

5  Total  —  outside  Federal  reservations 

6  National  Forest 

7  Indian  Reservations 

8  Military  Reservations 

9  Game  refuge 

10  National  Monument 

11  Total  —  inside  Federal  reservations 

12  Grand  total 


The  remainder  of  the  discussion  of  NCRI  is  applicable  to  NCRS 
The  NCRS  program  listing  follows : 
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/*  :SUMMARY_BY_LOCATION, REPORT=ROADLOG, DATA=SEC  */ 

/*  :SUMMARY_BY_LOCATION,REPORT=ROADLOG,DATA=SEC  */ 
SUMLOC:  PROC(PARM)  OPT  IONS ( MA  IN ) ; 

/**  SUMMARY  OE  ROUTE  LENGTHS  BY  LOCATION  EOR  THE  FAS  SYSTEM  **/ 
/**  FILE  FOR  ROAOLOG  INPUT  **/ 

DCL  ROADLOG  FILE  RECORD  INPUT  SEQL  KEYED  ENV( INDEXED ) ; 
/**  FOR  PRINTING  OUTPUT  **/ 
DCL  HEA0ING(9)     CHAR<132)  EXT, 
INSTR  CHAR<80) EXT, 
#_HDGS  PIC'Z'  DEF  INSTR  POS<72), 
PARM  CHAR(ICO) , 
#_LINES  PIC'ZZ', 

F(0:9)  PIC*Z*  INITIO, 1,2, 3, 4, 5, 6, 7, 8, 9)  , 
PRINTER  CHAR( 132)EXT, 
BLANKS  CHARC132)  INITI  •  •); 
/**  FOR  INPUT  OF  ROADLOG  VARIABLES  **/ 
DCL  1  RLG  STATIC, 

5  DUMMYl  CHAR(  1)  , 
5  KEY, 
10  SYSTEM  CHAR( 1) , 
10  (RT_#,MILEPOST)  PIC'ZZZ', 
10  OFFSET  CHAR<6) , 
5  REMARK  CHAR(2), 
5  DUMMY2  CHAR(3) , 
5  ROUTE  DEC  FIXED(5,3), 
5  DUMMY3  CHAR<8), 
5  DESCR  CHAR(35), 
5  DUMMY4  CHAR(26) , 
5  LQCN(2)  DEC  FIXED( 3,0), 
5  DUMMY5  CHAR(25) ; 
/**  FOR  OUTPUT  OF  SECONDARY  MILEAGE  TOTALS  PER  ROUTE  **/ 
DCL  1  NUM1  STATIC, 

5  RT_#  PIC'ZZZZZ* , 
5  ST0RE(12)  PIC'ZZZZZV.ZZZ1 ; 
/**  FOR  OUTPUT  OF  COLUMN  TOTALS  **/ 
DCL  1  NUM2  STATIC, 

5  REMARK  CHARI5)  IN  IT(  • TOTAL  •)  , 
5  T0TALU2)  P  IC  •  ZZZZZV  .  ZZ  Z  •  ; 
/**  LOCATIGN  CODES  USED  IN  VARIABLE  LOCN  IN  RLG  **/ 
DCL  LOCATION_CODE( 10)  DEC  FIXED(3,0) 
INITI 1,2,9,10,0,3,4,6,5,7); 
/**  BEGINNING  KEY  OF  FAS  RECORDS  **/ 
DCL  KEY  CHAR(16)  STATIC  IN  IT(  * S20 1000+0. 000' )  ; 
ON  ERROR  BEGIN; 

PRINTER=,***ERROR  IN  SUMMAR Y_BY_LOCAT I  ON  ROUTINE*; 
CALL  PRINTX(F(3> ) ; 
GOTO  CLOSE; 
END; 
CALL  INIT(PARM); 
/*  SFT  PAGE  HEADINGS  */ 
HEADING(1)  =  SUBSTR( BLANKS, 1,35)  I  I 'SUMMARY   OF   ROUTE   ■  II 

•LENGTHS   AND   LOCATIONS'; 
HEADING(2)=SUBSTR(BLANKS, 1,41) I | 'FEDERAL   AID   'II 

•SECONDARY   SYSTEM'; 
HEADING(4)=«  LOCATED   OUTSIDE   FEDERAL   RESERVAT I ONS •  I 

'     LOCATED       INSIDE       FEDERAL       RESERVATIONS'; 
HEADING(6)='  ROUTE  STATE       STATE        'I 

•     NATIONAL  INDIAN    MILITARY   GAME    NATIONAL        'II 
•     COMBINED*; 
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/*     :SUMMARY_BY_LOCAT ION, RE PORT=ROADLOG, DAT A= SEC    */ 
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HEADING(7)='   NO.     MUNIC    COUNTY    FOREST      PARK     '  II 
•TOTAL   FOREST    RESERV.   RESERV.    REFUGE  MONUMENT     'II 
•TOTAL    TOTAL1; 
#_HDGS=3; 

OPEN  FILE(ROAOLOG)  INPUT  T  ITLE (  • ROADLQG»  ) ; 
/**  INITIALIZE  INTERNAL  VARIABLES  */ 
STORE  =  0*.   TOTAL  =0; 

ON  ENOFILE(ROAOLOG)  GOTO  0UTPUT_2; 
/**  READ  FIRST  FAS  RECORD  **/ 
READ  FILE(ROADLOG)  INTO(RLG)  KEY(KEY); 
GOTO  CHECK; 

/*   MAIN  EXECUTION  LOOP  **/ 
/*  CONTINUE  READING  FAS  RECORDS  */ 
CONT:   READ  FILE  (ROADLOG)  INTO  (RLG); 
/**  AFTER  LAST  ROUTE,  OUTPUT  SYSTEM  TOTALS  **/ 

IF  RLG.KEY.SYSTEM-.=  «  S'  THEN  GOTO  0UTPUT_2; 
/*  OUTPUT  MILEAGES  AT  END  OF  EACH  ROUTE  */ 

IF  RLG.REMARK=' EN'  THEN  GOTO  0UTPUT_1; 
/*  IGNORE  DESCRIPTION  AND  COINCIDENT  TYPE  RECORDS  **/  *~ 

CHECK:  IF  RLG.REMARK=«  • | RLG. REMARK= • SP • I RLG.REMARK= • LP ' I  _ 

RLG.REMARK^NE*  |  RLG.REMARK=  '  OS  •   THEN  CALL  SORT; 
GOTO  CUNT; 
/**  0UTPUT_1  PRINTS  MILEAGE  TOTALS  FOR  A  SINGLE  ROUTE  */ 
/*  CALCULATE  NECESSARY  SUBTOTALS  AND  TOTALS  */ 
OUTPUT. l:  ST0RE*5)=ST0RE* 1)+ST0RE( 2 ) +STORE ( 3)+ STORE < 4 ) ; 
DO  1=6  TO  10; 

ST0RE(11>=ST0RE(11)+ST0RE( I );  - 

END; 
STORE* 12)  =  STORE(5)+STORE*  11 )  ; 
/*  PRINT  ROUTE  MILEAGE  */ 
NUM1.RT_#=RLG.RT_#; 

PRINTER=STRING(NUM1); 
CALL  PRINTX(Fd))  ; 
/*  STORE  ROUTE  MILEAGES  FOR  SYSTEM  TOTALS  */ 
DO  1=1  TO  12; 
TOTAL( I) -TOTAL* I )+STORE(I)  ; 
END; 

/*  set  route  mileages  to  zero  at  start  of  each  new  route  */ 

store=o; 

goto  cont; 
/*  0utput_2  prints  column  totals  */ 
0utput_2:  pr inter=string( num2 ) ; 
call  printx(f(2) ) ; 

GOTO  CLOSE; 
/*  THE  SORT  ROUTINE  DETERMINFS  THE  TYPE  OF  MILEAGE  IN  A 

PARTICULAR  RECORD  AND  STORES  THE  MILEAGE  IN  ARRAYS  */  ■ 

SORT:  PROC; 
/*  SINGLE  OR  DUAL  MILEAGE  CLASSIFICATION  RECORD  */ 

IF  LOCN<l)-=0  C  LOCN(2)-=0  THEN  GOTO  SI;  m 

/*    SORT  SINGLE  CLASSIFICATION  RECORDS  */ 
DO  1=1  TO  4,6  TO  10; 
IF  LOCNt 1)=L0CATI0N_C0DE( I )  THEN  DO; 
/*  STORE  DETECTED  MILEAGE  TYPE  */  " 

STORE* I )=STORE( II +ROUTE; 
FND; 

END;  m 

GOTO  S3; 
/*  SORT  DUAL  CLASSIFICATION  RECORDS  **/ 


/*     :SUMMARY_8Y_L0CATI0N,REP0RT=R0ADL0G,DATA=SEC    */ 
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Si:  IF  LOCN(l)-.=  l  THEN  GOTO  S2; 
DO  1=3,4,6  TO  10; 
IF  L0CN(2)=L0CATI0N_C0DE( I )  THEN  DO; 
STORE(I)=STORE( I )+ROUTE; 
END; 
END; 
GOTO  S3; 
S2:    IF  L0CN(1)=3  |  LOCN(2)=3  THEN  DO; 
ST0RE(6)=ST0RE(6)+R0UTE; 
END; 
S3:    END  SORT; 
CLOSE:   CLOSE  F I LE ( ROADLOG) ; 

CALL  EXIT  (PARMI; 
END  SUMLOC; 
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FORHWY- SUMMARY  —  FORHWY- SUMMARY  is  composed  of  two  separate  programs:  ^ 

NERL  for  production  of  FHSUMMARY=LOCATION,  and  NERS  for  FH SUMMARY= SURF -TYPE . 

— 


FHSUMMARY=LOCATION : 

Member  Name NERL  n 

Language PL /I  ~* 

Subroutines  PRINTX1  L 

Files SYSPRINT  —  IBM  messages  _ 

PRINTER  —  FORHWY-SUMMARY  output 

ROADLOG  —  Road log  file  N 

Instruction 1  -  4  "NERL" 

NERL  processes  the  entire  Roadlog  file,  searching  for  records 
with  non-zero  forest  highway  number.   Mileages  are  stored  by 
route  and  by  location  code  in  array  MLGES .   After  the  end-of- 
file  has  been  detected  on  the  Roadlog  file,  the  summary  is 
printed. 

The  NERL  program  listing  follows: 
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/*  :FORHWY_SUMMARY,REPORT=ROADLOG,FHSUMMARY=LOCATION  */ 

l:  /*  :FORHWY_SUMMARY,REPORT=ROADLOG,FHSUMMAPY=LOCATION  */ 
2:  FORHWY:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 


3:  /*****  DECLARATIION  OF  VARIABLES  (ALPHABETICAL  ORDER)  *****/ 


DECLARE 

#_HDGS    PICZ'    DEF     INSTR    POS(72), 

BLANKS    CHARU32)      INITC     •)» 

CODE(3)    CHAR(8)     INITC       PRIM',1       SEC1,'    TOTAL'), 

F(0:9)    PIC'Z'     STATIC     INIT    (0,1,2,3,4,5,6,7,8,9), 

HEADING(9)    CHAR(132)     EXT, 

INSTR    CHAR(80)     EXT, 

JX(3)     BIN    FIXED    INIT(2,1,2), 

1       MLGE    STATIC, 

3      ROUTE.PRIM    P  IC ZZZVZ ZZ ' , 
3       ROUTE_SEC       P  IC ZZZVZZZ '  , 
3      CONST    PIC ZZZZVZZZ', 
3       UNIMP    PIC  ZZZVZZZ'  , 
3       WYE    PIC'ZVZZZ' , 
3      CITY    PICZZVZZZS 
3       CNTY    PICZZZVZZZ', 
3       NFOR    PICZZZVZZZ', 
3       SFOR    PICZZZVZZZ', 
3       IRES    PIC'ZVZZZ*  , 
3       PARK    PIC'ZVZZZ'  , 
L       MLGES(65)     STATIC    LIKE    MLGE, 
1       OUT.STRUCT    STATIC, 

3       FORHWY_#    PICZZZZZBBB'  , 
3       MILEAGE, 

5       ROUTE_PRIM    P  IC ZZ ZZZV .ZZZ  '  , 
5      ROUTE_SEC    PI C ZZZZZ V. ZZZ ' , 
5      CONST    PICZZZZZZZZV.ZZZ' , 
5       UNIMP    PICZZZZZV.ZZZ'  , 
5       WYE    PICZZZV.ZZZ' , 
5      CITY    PICZZZZZZZV.ZZZ' , 
5       CNTY    PICZZZZZV.ZZZ'  , 
5       NFOR    PICZZZZZV.ZZZ', 
5       SFOR    PICZZZZV.ZZZ'  , 
5       IRES    PICZZZV.ZZZ', 
5       PARK    PICZZZV.ZZZ', 
3      GRAND_TOTAL    P IC • ZZZZZZZ ZZV . ZZZ  '  , 
PARM    CHAR(IOO) , 
PRINTER    CHAR(  132)     EXT, 
1       RLG    STATIC, 

3       DUMMY1    CHAR(  1) , 
3       SYSTEM    CHAR( 1) , 
3       DUMMY2    CHARC 12)  , 
3       REMARK    CHAR(2), 

3       (SECTN, ROUTE, CONST, UNIMP)DEC    FIXED(5,3), 
3    WYE    DEC    FIXED(3,3), 
3    DUMMY3    CHAR( 57)  , 
3       (F0RHWY_#,DUMl,L0CN(2) )DEC    FIXED(3,0), 
3    0UMMY4    CHAR(25), 
D4    CHAR(4) , 

ROADLOG    FILE    RECORD    KEYED    ENV( INDEXED  )  , 
1       T0TALS(3)     LIKE    MLGE; 
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/*  :FORHWY_SUMMARYtREP0RT=R0ADL0G,FHSUMMARY=L0CATION  */ 


55:  /*****  PROGRAM  INITIALIZATION  *****/ 

56:  ON  ERROR  BEGIN; 

57:         PRINTER  =  »***  ERROR  IN  FORHWY_SUMMARY  ROUTINE'; 

58:        CALL  PRINTX  (F(3)) ; 

59:        GOTO  RETURN; 

60:        END; 

61:  CALL  INIT  (PARM); 


62 
63 
64 
65 
66 
67 
68 
69 
70 
71 
12 
73 
74 
75 
76 


84 

"  85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 

100 

101 

102 

103 


/***  SET  UP  PAGE  HEADINGS  ***/  ta 

#_HDGS  =  8; 

HEADING(l)  =  SUBSTR(BLANKS,1,25)  II 

•MONTANA  FOREST  HIGHWAY  SYSTEM';  I 

HEADING(3)    =    SUBSTR ( BLANKS, 1 ♦ 34)     II 

•CONSTRUCTION         DETAILS1; 
HFADING(5)    ■     •    FOREST  ROUTE    LENGTH  •     II      . 

•  IMPROVEMENT  STATUS         '11 
•*************#**  LOCATED  IN  A****************1; 

HEADING(6)  =  •HIGHWAY    *****************      •  || 

<**********************       'II  i 

•  NATIONAL    STATE   INDIAN  GRAND'; 
HEA0ING<7)  =  •  ROUTE     PRIMARY  SECONDARY      •  II 

•CONSTR    UNIMP      WYE       •  II 

•CITY     COUNTY   FOREST    FOREST  RESERVE  PARKS        TOTAL1; 


77:  /***  open  ROADLOG  FILE  ***/ 

78:  OPEN  FILE  (ROADLOG)  INPUT  SEQL; 

79:  ON  ENDFILE  (ROADLOG)  GOTO  PR INT.SUMMARY; 

80:  MLGES  ■  0; 

81:  TOTALS  =  0; 


82:  /*****  MAIN  CONTROL  SECTION  ****/ 

83:     /***  RFAD  ROADLOG  FOREST  HIGHWAY  DATA  ****/ 


READ_RLG_RECORD: 

READ  FILE  (ROADLOG)  INTO  (RLG); 

IF  RLG.FORHWY_#=0  THEN  GOTO  READ_RLG_R ECORD ; 

MLGE  =  0; 

IF    RLG.SYSTEM='S»    THEN    MLGE. ROUTE_SEC    =   RLG. ROUTE; 

ELSE    MLGE.ROUTE.PRIM    =    RLG. ROUTE; 
MLGE. CONST     =    RLG.SECTN    -    RLG. UNIMP    -    RLG. WYE; 
MLGE. UNIMP    =    RLG. UNIMP; 
MLGE. WYE    =    RLG. WYE; 
DO    Jl=l; 
IF    RLG.LOCNI Jl)=l    THEN    ML GE .C I TY=RLG. SFCTN ; 
ELSE     IF     RLG.LOCN( Jl)=2    THEN    MLGE .CNT Y=RLG. SECTN ; 
FLSE     IF    RLG.LOCN( Jl)=3    THEN    MLGE .NFOR=RLG. SECTN ; 
FLSE     IF    RLG.LOCN( J  1 ) =9    THEN    ML GF . SFOR  =  RLG. SECTN ; 
FLSE     IF    RLG.LOCN( Jl)=4    THEN    ML GE . IRE S=RLG. SEC TN ; 
FLSE     IF    RLG.LOCN( J  1 ) =8    THEN    MLGE . PARK  =  RLG. SEC TN ; 
ELSE     IF    RLG.LOCN( Jl)=10    THEN    ML GE .PARK=RLG. SECTN ; 
ELSE    DO; 
04='     •; 
IF    RLG.LOCNI Ji)=5    THEN    D4='IRES»; 
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/*    :FORHWY_SUMMARY,REPORT=ROADLOG,FHSUMMARY=LOCATION    */ 

104:  TF    RLG.LOCNU  Jl)=6    THEN    D4-»MRES«; 

105:  IF    RLG.LOCN( Jl)=7    THEN    D4=«NM0N»; 

106:  PRINTER=»**INVALID  CLASS  IF ICATION , • I  I RLG. SYSTEM | 

107:  RLG.DUMMY2U  •  ,»  |  I  04; 

108:  CALL  PRINTX  <F<  1)  >  ; 

109:  END; 

110:  END; 

111:  MLGES(RLG.FORHWY_#)  =  MLGES( RLG.FORHWY_#)  +  MLGE; 

112:  IF  RLG.SYSTEM=«S«  THEN  T0TALSI2)  =  T0TALS(2)  +  MLGE; 

113:  ELSE  TOTALS(l)  =  TOTALS(l)  +  MLGE; 

114:  GOTO  READ_RLG_RECORD; 

H5:  /***  PRINT  THE  SUMMARY  (NON-ZERO  LINES  ONLY)  ****/ 


116 
117 
118 
119 
120 
121 
122 
123 
124 
125 
126 


PRINT_SUMMARY: 

"DO  J  1=1  TO  65; 

IF  MLGES(Jl) .ROUTE_PRIM=0  L    MLGES ( J  1 ) .ROUTE_SEC=0  THEN  GOTO  NEXT; 

MLGE  =  MLGES( Jl) ; 

OUT_STRUCT.FORHWY_#  =  Jl; 

OUT_STRUCT. MILEAGE  =  MLGE; 

aUT_STRUCT.GR AND_TOTAL  =  MLGE. CONST  ♦  MLGE.UNIMP  +  MLGE. WYE; 

PRINTER  =  STRING(OUT_STRUCT) ; 

CALL  PRINTX  CF(ll); 


NEXT: 


END; 


127:  /***  PRINT  THE  TOTALS  ***/ 

128:  T0TALS(3)  =  TOTALS(l)  ♦  T0TALS(2); 

129:  DO  Jl=l  TO  3; 

130:  OUT.STRUCT. MILEAGE    =    TOTALS(Jl); 

131:  OUT_STRUCT.GRAND_TOTAL    =    TOTALS  Ul )  .CONST    +    TOTALSC J  I ) . UNI  MP    + 

132:  TOTALS(Jl) .WYE; 

133:  PRINTER  =  STR ING (OUT_STRUCT) ; 

134:  SUBSTR(PRINTER, 1,8)  =  CODE(Jl); 

135:  CALL  PRINTX  (F(JX(J1))); 

136:  END; 

137:  RETURN: 

138:  CLOSE  FILE  (ROADLOG); 

139:  CALL  EXIT  (PARMI; 

140:  END  FORHWY; 
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FHSUMMARY=SURF-TYPE : 

Member  Name NERS 

Language PL/ 1 

Subroutines  PRINTX1 

SRTYPR 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  FORHWY- SUMMARY  output 

ROADLOG  —  Road log  file 

SURFTBL  —  Surface  type  table  (SRTYPR) 

Instruction 1  -  4  "NERS" 

NERS  is  the  second  forest  highway  summarization  program,  which 
computes  a  summary  based  on  forest  highway  number  and  surface 
type.  As  in  NERL,  the  entire  Roadlog  file  is  scanned  for 
forest  highway  records,  and  the  values  accumulated  in  an  array 
MLGE.   Subroutine  SRTYPR  is  used  to  transform  the  4-digit 
surface  type  code  into  a  1-digit  classification  between  1  and 
8.   Primary  and  Interstate  mileage  is  kept  separate  from 
Secondary  mileage  for  the  summary.  After  setting  up  the 
values  in  MLGE,  the  summary  is  printed. 
The  NERS  program  listing  follows: 
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/*  :FORHWY_SUMMARY,REPORT=ROADLOG,FHSUMMARY=SURF_TYPE  */ 

l:  /*  :FORHWY_SUMMARY,REPORT=ROADLOG,FHSUMMARY=SURF_TYPE  */ 
2:  FORHWY:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 

3:  /*****  DECLARATION  OF  VARIABLES  (ALPHABETICAL  ORDER)  *****/ 

DECLARE 

#_HDGS  PIC'Z'  DEF  INSTR  POSI72), 

BLANKS  CHAR(132)#  INITC  •), 

CNTR  BIN  FIXED,  ' 

F(0:9)  PIC'Z'  STATIC  INIT  (0,1,2,3,4,5,6,7,8,9), 

HDG(8,2)  CHAR(IO), 

HEADING(9)  CHAR(132)  EXT, 

INSTR  CHAR(80)  EXT, 

MLGE(62,2,9)  P IC • ZZZVZZZ • , 

1   OUT_STRUCT, 

3   FORHWY_#  PIC'ZZZZBB', 

3   SYSTEM  CHAR( 10) , 

3   MILESI9)  PIC'ZZZZZZV.ZZZ' , 
PARM  CHAR(IOO) , 
PP INTER  CHAR( 132)  EXT, 
1   RLG, 

3   DUMMY1  CHAR( 1), 

3   SYSTEM  CHAR(l), 

3   DUMMY2  CHAR( 14) , 

3   SECTN  DEC  F1XED(5,3), 

3   DUMMY3  CHAR(68) , 

3   FORHWY_#  DEC  FIXED(3,0), 

3   DUMMY4  CHAR( 17) , 

3   SURF_TYPE  DEC  FIXED(5,0), 

3  DUMMY5  CHAR (11) , 
ROADLOG  FILE  RECORD  KEYED  ENV( INDEXED ) , 
SYSTEM(3)  CHAR(IO)  INIT(»  PRIMARY*, •  SECONDARY*,'  TOTAL'); 

31:  /****  PROGRAM  INITIALIZATION  *****/ 

ON  ERROR  BEGIN; 

PRINTER  =  •***  ERROR  IN  FORHWY_SUMMARY  ROUTINE1; 

CALL  PRINTX  (F( 3) ) ; 

GO  TO  RETURN; 

END; 
CALL  INIT  (PARM); 
#_HDGS  =  7; 
HEADING(1)=SUBSTR( BLANKS, 1,30)  II  'SUMMARY  OF  SURFACE  TYPES  —  ' 

•FOREST  HIGHWAY  SYSTEM'; 
HEADING(3)  =  SUBSTR ( BLANKS, 1 , 29 )  ||  'NET  CONSTRUCTED  LENGTH  —  • 

•BY  FOREST  HIGHWAY  ROUTES'; 
HEADING(5)  =  'FOREST  PRIM-      UNIM-    GRADED  & '  II 

•  GRAVEL   BIT  SURF      ROAD        PLANT       P.  C.  ■  II 

•  TOTAL'; 
HEADING(6)  =  'RT.NO.   SYSTEM       ITIVE     PROVED    DRAINED  •  II 

•  TREATED       MIX  MIX       CONCRETE'; 

48:     /***  INITIALIZE  SRTYPR  SURF  TYPE  DECODING  ROUTINE  ***/ 
49:     CALL  SRTYPRI; 
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/*     :FORHWY_SUMMARY,REPORT=ROADLGG,FHSUMMARY=SURF_TYPE    */ 


50:  /***  OPEN  FILES  ***/ 

51:  OPEN  FILE  (ROADLOG)  INPUT  SEQL; 

52:  ON  ENDFILE  (ROADLOG)  GOTO  PR  INT_SUMMARY; 

53:  /***  INITIALIZE  VARIABLES  AND  ARRAYS  ***/ 

54:  MLGE  =  0; 

55:  /***  SCAN  ROADLOG  FILE  FOR  PRIM/SEC  DATA  ***/ 


56 
57 
53 
59 
60 
61 
62 
63 
64 
65 
66 
67 
68 
69 
70 
71 


READ_RLG_RECORD: 

READ  FILE  (ROADLOG)  INTO  (RLG); 

IF  RLG.FORHWY_#=0  THEN  GO  TO  READ_RLG_RECORD; 

Jl  =  RLG.FORHWY_#; 

IF  RLG.SYSTEM=«S*  THEN  J2  =  2;     ELSE  J2  =  1; 

J3  =  rlg.surf_type; 

CALL  SRTYPPA  (J3); 
IF  J3=0  THEN  DO; 

PRINTERS***  ILLEGAL  SURFACE  TYPE  DETECTED,  '  I  I  RLG .  SYSTEM 
SUBSTR(RLG.DUMMY2,1, 12) 1  I • , '  II  RLG. SURF_TYPE ; 

CALL  PRINTX  <F< 1 ) ) ; 

GO  TO  READ_RLG_RECORD; 

END; 
MLGE( Jl, J2, J3)  =  MLGEU1,  J2,  J3)  ♦  RLG.SECTN; 
MLGE( J1,J2,9)  =  MLGE( J1,J2,9)  +  RLG.SECTN; 
GO  TO  READ_RLG_RECORD; 


72:     /***  PRINT  THE  SUMMARY  ***/ 

73:  PRINT_SUMMARY: 

74:     /***  PRINT  THE  NON-ZERO  LINES  OF  SUMMARY  ***/ 

75:     DO  J  1=1  TO  62; 

76:        CNTR  =  0; 

77:        J2  =  2; 

78:        GUT_STRUCT.FORHWY_#  =  Jl; 

79:        CALL  PR INT_PR IMARY  (Jl); 

80:        CALL  PR INT_SECONDARY  (Jl); 

81:        IF  CNTR>1  THEN  CALL  PRINT_TOTALS  (Jl); 

82:        END; 

83:  RETURN: 

84:     CLOSE  FILE  (ROADLOG); 
85:     CALL  EXIT  (PARM); 
86:     RETURN; 

87:  /*****  SUBROUTINE  TO  DO  ACTUAL  PRINTING  *****/ 


88:  PRINT.PRIMARY:   PROCEOURE  (J3); 

89:     J4  =    l; 

90:     GO  TO  ENTRY; 

91:  PRINT_SECONDARY:   ENTRY  (J3); 
92:     J4  =  2; 

93:  ENTRY: 
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/*  :FORHWY_SUMMARY,REPORT=ROADLOG,FHSUMMARY=SURF_TYPE  */ 

94:     OUT_STRUCT. MILES  =  MLGEC J3, J4,* ) ; 

95:     IF  J3-.=  62  THEN  MLGE  (  62,  J4,  *  )  =  MLGE ( 62 , J4,* )  +  MLGE( J3 , J4 , *} ; 

96:     GO  TO  CONTINUE; 

97:  *PRINT_TOTALS:       ENTRY    ( J3 ) ; 

98:  J4    =    3; 

99:~  OUT_STRUCT. MILES    =    MLGEU3,!,*)    +    MLGE ( J3, 2 ,*> ; 


100 
101 
102 
103 
104 
105 
106 
107 
108 
109 


CONTINUE: 

IF  0UT_STRUCT.MILES(9)=0  THEN  RETURN; 

OUT.STRUCT.  SYSTEM  =  SYSTEMU4); 

PRINTER  =  STRING(OUT_STRUCT); 

IF  J3=62  L    J4=l  THEN  SUBSTR ( PR  INTER , 1 ,6 )  =  'TOTALS'; 

CALL  PRINTX  (F(J2) ) ; 

J2  =  1; 

CNTR  =  CNTR  «-  1; 

OUT_STRUCT.FORHWY_#  =  0; 

END  PRINT.PRIMARY; 


110:  END  FORHWY; 
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SUM-LOOPS-&-SPURS  — 

Member  Name NFR 

Language PL /I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  SUM-LOOP S-&- SPURS  output 

ROADLOG  —  Roadlog  file 

SPURTBL  —  Table  of  spurs  and  loops 

Instruction 1  -   3  "NFR" 

SUM-LOOPS-&-SPURS  prints  a  summary  with  one  line  for  each  spur  or  loop  on  the 
Primary  system.   It  is  not  possible  to  determine  directly  from  the  Roadlog 
file  exactly  where  spurs  and  loops  end;  hence,  a  table  is  used  which  specifies 
the  beginning  and  ending  keys  of  each  spur  and  loop.   The  table  also  contains 
a  description  of  each  spur  and  loop  which  is  printed  in  the  summary.   Out-of- 
state  mileage  is  not  included  —  each  record  in  the  spur/loop  is  tested  for 
remark  codes  "  ,"  "SP,"  "LP,"  and  "NE."  The  mileage  is  accumulated  in  an 
array  M,  whose  subscript  indicates: 


1 

Route  length 

2 

Construction  length 

3 

Unimproved  length 

4 

Wye  length 

5 

Municipal 

6 

County 

7 

National  Forest 

8 

Indian  Reservation 

9 

Other 

0 

Total  rural  mileage 

After  scanning  an  entire  loop  or  spur,  its  values  are  printed,  and  the  next 
record  of  SPURTBL  read.  After  the  end-of-file  is  raised  on  SPURTBL,  a  line 
of  totals  are  printed. 

The  NFR  program  listing  follows: 
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/*  :SUM_L00PS_6_SPURS,REP0RT=R0ADL0G  */ 

l:  /*  :SUM_LOOPS_£_SPURS,REPORT=ROADLOG  */ 
2:  SUMLPSP:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 

/*  PRINT  SUBROUTINE  */ 
DECLARE 

PARM  CHAR(  100)  , 

INSTR  CHAR(80)  EXT, 

#_HDGS  PIC'Z'  DEF  INSTR  POS<72), 

BLANKS  CHAR(50)  INIT{  •  '  ), 

HFADING(9)  CHAR(132)  EXT, 

F(0:9)  PIC'Z'  STATIC  IN  I T  (0,1,2,3,4,5,6,7,8,9), 

PRINTER  CHAR(  132)  FXT; 

/*  INPUT/OUTPUT  VARIABLES  */ 
DECLARE 

ROADLOG  FILE  RECORD  KEYFD  ENV(  INDE XED  )  , 

TABLE  FILE  RECORD, 

1   RLG  BASED  (PTR_RLG), 

3   DUM1  CHAR( 1) , 

3   KEY  CHAR( 13)  , 

3  REMARK  CHAR(2)  , 

3  (SECTN, ROUTE, CONST, UNIMP)  DEC  FIXFD(5,3), 

3  WYE  DEC  FIXED( 3,3), 

3  DUM2  CHAR(61)  , 

3  L0CN(2)  DEC  FIXED(3,0) , 
1   IN  BASED  (PTR.TBL)  , 

3   DESCR  CHAR(20), 

3   RT_#  CHAR(4) , 

3   DUM1  CHAR(l), 

3   MIP0ST1  CHAR (9), 

3   DUM2  CHAR(  1)  , 

3   MIP0ST2  CHAR(9)  , 
1   INI  BASED  (PTR_TBL), 

3   DUM1  CHAR(21  )  , 

3       RT_#    PIC'ZZZ'  , 
1       OUT    DEF    STRING_GUT, 

3       RT_#    PIC'ZZZZBBB' , 

3   DESCR  CHAR(22), 
2   MILEAGFS, 

3   ROUTE  PIC'ZZZV.ZZZ', 

3      CONST    PIC'ZZZZZV.ZZZ' , 

3       UNIMP    PIC  ZZZZV.Z7Z' , 

3      WYE    PIC'ZZZV.ZZZ', 

3   CITY  PIC'ZZZZZZZV.ZZZ' , 

3   CNTY  PIC'ZZZZV.ZZZ', 

3   NFOR  PIC'ZZZZV.ZZZ', 

3   IRES  PIC'ZZZZV.ZZZ', 

3   OTHER  PIC'ZZZV.ZZZ', 

3   RURAL  PIC'ZZZZZZV.ZZZ' , 
STRING_OUT  CHARU32)  STATIC; 

49:  /*  OTHER  VARIABLES  */ 

50:  DECLARE 

51:     CARRIAGE  DEC  FIXED  (1), 

52:     ENDKEY  CHAR(16)  STATIC, 

53:     STARTKEY  CHAR(16)  STATIC, 

54:     M(10)  PIC'ZZZVZZZ'  STATIC, 

55:     1   M_STRCT  DEF  M, 


/*  :SUM_LOOPS_£_SPURS,REPORT=ROADLOG  */ 

56:         3  (MAfMB,MC,MD,ME,MF,MG,MH,MI,MJ)  P IC ' ZZZ VZ Z Z ' , 
57:     TOT(IO)  PIC'ZZZVZZZ'  STATIC; 


58:  /*****  INITIALIZATION  *****/ 


59 
60 
61 
62 
63 
64 

65 

66 

67 

68' 

69 

70: 

71: 

72: 

73: 

74: 


ON  ERROR  BEGIN; 

PRINTER  =  •***  ERROR  IN  SUM_LOOPS_£_SPUR S  ROUTINE1; 

CALL  PRINTX  (F(3)); 

GOTO  RETURN; 

END; 
CALL  INIT  (PARM); 

/***  SET  UP  PAGE  HEADINGS  *****/ 

#_HDGS  =  5; 

HEADING(l)  =  SUBSTR(BLANKS,lf  30)  II 

•SUMMARY  OF  LOOPS  AND  SPURS  ON  FEDERAL  AID  PRIMARY  SYSTEM'; 

HEADINGI3)  =  'ROUTE 

t 


I  I 


NATL 


INDIAN 


'       NET'; 
HEADINGS)  =  •  NO. 
•    UNIMP     WYE 
'      RURAL'; 


LOCATION  ROUTE     CONST'  | | 

MUNIC   COUNTY   FOREST   RESERVE   OTHER' 


' 


75:  /***  INIT  VAR  ***/ 

76:  CARRIAGE  =  1; 

77:  TOT  =  0; 

78:  M  =  0; 

79:  STRING_OUT  =  •  • ; 

80:  /***  INIT  FILES  ***/ 

81:  OPEN  FILE  (TABLE)  INPUT  SEQL  RECORD  TITLE  ('SPURTBL'); 

82:  OPEN  FILE  (ROADLOG)  INPUT  SEQL; 

33:  ON  ENDFILE  (TABLE)  GOTO  FINISH; 


84:  /*****  MAIN  EXECUTION  LOOP  *****/ 


85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 

100 

101 

102 

103 


KEY  (STARTKEY); 


OOP: 

READ  FILE  (TABLE)  SET  (PTR_TBL); 
STARTKEY  =  IN.RT_#  ||  IN.MIP0ST1; 
ENDKEY  =  IN.RT_#  ||  IN.MIP0ST2; 
READ  FILE  (ROADLOG)  SET  (PTR_RLG) 
DO  WHILE  (RLG.KEY<ENDKEY) ; 

IF  RLG.REMARK='   '  J  RLG .REMARK= • SP1 
RLG.REMARK='NE' 
THEN  DO; 

♦  RLG. ROUTE; 

♦  RLG.SECTN  -  RLG. UNIMP  - 

♦  RLG. UNIMP; 

♦  RLG. WYE; 


M(  I)  = 
M(2)  = 
M(  3)  = 
M(4)  = 
DO  1  =  1 
IF 


M(l) 
M(2) 
M(3) 
M(4) 
TO  2; 
RLG.LOCN(  I)=l 


I     RLG.REMARK='LP»      I 


RLG. WYE; 


THEN    M(5)=M( 5J+RLG.SECTN; 


ELSE  IF  RLG.LOCN( I)=2    THEN    M( 6 ) =M( 6 ) +RLG. SEC TN ; 

ELSE  IF  RLG.LOCN( I)=3    THEN    M( 7)=M( 7) +RLG. SEC TN ; 

ELSE  IF  RLG.LOCN( I)=4    THEN    M ( 8 )=M( 8 ) +RLG. SECTN ; 

ELSE  IF  RLG.LOCNt  I)-=0    THEN    M ( 9) =M( 9) + RLG. SEC TN ; 


' 
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/*  :SUM_LOOPS_£_SPURS,REPORT=ROADLOG  */ 


104 
105 
106 
107 
108 
109 
110 
111 
112 
113 
114 
115 
116 


END; 

IF  RLG.LOCNC 1)-=1  THEN  M ( 10 )  =  M< 10) +RLG. SECTN ; 
ENO; 
REAO  FILE  (ROADLOG)  SET  (PTR_RLG>; 
END; 
OUT.RT_#  =  IN1.RT_#; 
OUT.DESCR  =  IN.DESCR; 
OUT. MILEAGES  =  M_STRCT; 
PRINTER  =  STRING_OUT; 
CALL  PRINTX  (F{  1 ) ) ; 
TOT  =  TOT  ♦  M; 
M  =  0; 
GOTO  LOOP; 


117:  FINISH: 

118:     STRING_OUT  =  'TOTAL*; 

119:     M  =  TOT; 

120:     OUT. MILEAGES  =  M.STRCT; 

121:     PRINTER  =  STRING.OUT; 

122:     CALL  PRINTX  (F(2)); 


123:  RETURN: 

124:     CLOSE  FILE  (TABLE) ; 
125:     CLOSE  FILE  (ROADLOG); 
126:     CALL  EXIT  (PARM); 


127:  END  SUMLPSP; 
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CHAPTER  2-III 
TRAFFIC  AND  TRUE  MILEAGE  PROGRAMMER  INFORMATION 

Introduction 

This  chapter  presents  a  description  of  programs  comprising  the  Traffic 
and  True  Mileage  subsystems  of  HIS.   It  is  designed  for  utilization  with  the 
publication  Highway  Information  System  Volume  1:   User  Information. 

Traffic  File  Description 

Data  Set  Name HIS. TRAFFIC 

Organization   Indexed  Sequential 

Logical  Record  Length  80 

Physical  Record  Length   ....  1280 

Key  Length 13 

Volume  Serial  Number   231428 

The  internal  format  of  a  Traffic  record  is  shown  in  Figure  2-III-1. 
Most  of  the  numeric  fields  are  stored  in  packed  decimal  format  to  conserve 
storage  and  improve  efficiency.   The  route  number,  reference  post,  and  distance 
from  reference  post  are  stored  in  character  format  in  the  key  for  ease  in 
cross-referencing  other  HIS  files,  and  also  in  packed  decimal  format  for 
computational  efficiency. 

In  addition  to  the  traffic  count  and  descriptor  records  in  the  file 
coded  by  the  user,  a  "year"  record  with  key  "A000"  (followed  by  9  blanks) 
exist.   This  record  contains  in  character  format  the  years  for  which  data  in 
the  files  refer.   The  oldest  year  is  in  positions  15-16,  the  next  in  positions 
17-18,  the  next  in  positions  19-20,  and  the  latest  year  in  positions  21-22. 
Positions  23-80  of  this  record  contain  blanks. 


I 
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TRAFFIC  RECORD, 

2 

DELETE  CHARACTER 

2 

KEY, 

3  ROUTE  SYSTEM 

3   ROUTE  NUMBER 

3  REFERENCE  POST 

3  DISTANCE  " 

2 

ROUTE  NUMBER 

2 

REFERENCE  POST 

2 

DISTANCE 

2 

ACTUAL  ESTIMATED  CODE 

2 

REMARK 

2 

FIRST  YEAR, 

3  YEAR 

3  AVERAGE  DAILY  TRAFFIC 

.3   PERCENT  OUT  OF  STATE 

3  PERCENT  PICKUPS 

3  PERCENT  COMMERCIAL 

2 

SECOND  YEAR 

2 

THIRD  YEAR 

2 

FOURTH  YEAR 

2 

FUTURE  FACTOR 

2 

DESIGN  HOUR  VOLUME 

2 

DATE  OF  UPDATE, 

3  YEAR 

3  MONTH 

3   DAY 

2 

DUMMY 

CHAR(l)  , 

CHAR(l)  , 
CHAR (3) , 
CHAR(3) , 
CHAR(6) , 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
CHAR(l) , 
CHAR(l) , 

DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
DEC  FIXED 
LIKE  FIRST 
LIKE  FIRST 
LIKE  FIRST 
DEC  FIXED 
DEC  FIXED 

CHAR(2), 
CHAR(2), 
CHAR(2) , 
CHAR(3); 


(3,0), 
(3,0), 
(5,3), 


(2,0), 
(5,0), 
(3,3), 
(3,3), 
(3,3), 
_YEAR, 
_YEAR, 
_YEAR, 
(3,3), 
(3,3), 


Figure  2-III-1.   Traffic  file  structure. 
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True  Mileage  File  Description 

Data  Set  Name HIS.TRUMILE 

Organization   Indexed  Sequential 

Logical  Record  Length  16 

Physical  Record  Length   ....  1280 

Key  Length 7 

Volume  Serial  Number   231428 

The  internal  format  of  a  True  Mileage  record  is  shown  in  Figure  2-III-2. 

Traffic  Summary  File  Description 

Data  Set  Name HIS.TRAFSUM 

Organization   Indexed  Sequential 

Logical  Record  Length  96 

Physical  Record  Length   ....  1632 

Key  Length 13 

Volume  Serial  Number   231428 

The  Traffic  Summary  file  is  generated  by  program  CREATE-TRAFSUB  from  the 
Traffic  and  True  Mileage  files.   The  record  format,  in  PL/ I  terminology,  is 
shown  in  Figure  2-III-3. 

Four  types  of  records  occur  in  the  file:   year  records,  section  records, 
descriptor  records,  and  totals  records. 

There  is  one  year  record  in  the  file.   This  record  contains  key  "A000" 
(followed  by  9  blanks) ,  and  contains  in  character  format  the  years  for  which 
the  data  in  the  file  refers.   The  oldest  year  is  in  positions  15-16,  the 
next  in  positions  17-18,  and  the  latest  in  positions  19-20.   The  remainder  of 
the  year  record  contains  blanks . 

One  section  record  appears  in  the  Traffic  Summary  file  for  each  section 
defined  in  the  Traffic  file.   The  remark  code  contains  a  "W,"  "T,M  "0,"  or  "NM 
for  rural,  municipal,  out-of-state,  and  non-existent  sections,  respectively. 

A  number  of  descriptor  records  occur  in  the  Traffic  Summary  file.   These 
records  contain  only  a  key  and  a  remark  code.   A  record  containing  a  "C,"  "S," 
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TRUE_MILEAGE_RECORD , 

2      DELETE_CHARACTER  CHAR(l) , 

2     KEY, 

3  ROUTE_SYSTEM  CHAR(l) , 

3  ROUTE_NUMBER  CHAR (3) , 

3   REFERENCE_POST  CHAR(3) , 

2  TRUE_MILEAGE  DEC  FIXED  (7,3), 

2  DATE  OF  UPDATE  DEC  FIXED  (6,0); 


Figure  2-III-2.   True  mileage  file  structure 
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TRAFF  IC_SUMMARY_RECORD , 
2  DELETE_CHARACTER 
2  KEY, 

3  ROUTE_SYSTEM 

3  ROUTE_NUMBER 

3  REFERENC_POST 

3  DISTANCE 
2  REMARK 
2   SECTION_LENGTH 
2  FIRST_YEAR, 

3  VEHICLE_MILEAGE 

3  OUT_OF_STATE_VEHICLE_MILEAGE 

3   PICKUPS_VEHICLE_MILEAGE 

3   COMMERCIAL_VEHICLE_MILEAGE 
2   SECOND_YEAR 
2  THIRD_YEAR 
2  DUMMY 


CHAR(l), 

CHAR(l) , 
CHAR (3), 
CHAR(3) , 
CHAR(6) , 
CHAR(l) , 
DEC  FIXED  (7,3), 

DEC  FIXED  (11,3), 
DEC  FIXED  (11,3), 
DEC  FIXED  (11,3), 
DEC  FIXED  (11,3), 
LIKE  FIRST_YEAR, 
LIKE  FIRST_YEAR, 
CHAR (5) ; 


i 


Figure  2-III-3.   Traffic  summary  file  structure, 
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or  "L"  code  occurs  for  each  "C,"  "S,"  or  ML"  record  in  the  Traffic  File.   A 
record  containing  a  "D"  code  occurs  just  prior  to  each  of  the  "C,"  "S,"  or 
"L"  records;  these  allow  the  retrieval  of  descriptions  from  the  Roadlog  file 
before  the  coincident  sections,  spurs,  and  loops  begin.   Finally,  a  record 
with  an  "E"  code  appears  at  the  end  of  each  route,  allowing  the  retrieval  of 
the  end-of-file  description  from  the  Roadlog  file.   After  the  "E"  record  of 
each  route  is  a  totals  record.   The  totals  record  has  key  "snnn9 99 RURAL," 
where  s  is  an  "I,"  "P,"  or  "S"  indicating  the  route  system  and  nnn  is  the 
Federal  Aid  route  number.   The  record  contains  the  total  rural  mileage  and 
vehicle  miles  of  the  route.   In  addition,  the  last  route  of  each  route  system 
is  followed  by  a  totals  record  with  key  "s999RURAL."  This  record  contains 
the  total  rural  mileage  and  vehicle  miles  for  the  system. 

CONVTRF  Subroutine 

Object  Module  Name  CONVTRF 

Language PL/I 

Files SYSPRINT 

Entry  Points  CONVDEC 

CONVPIC 

Several  of  the  programs  in  the  Traffic  and  True  Mileage  subsystem  utilize 
the  CONVTRF  subroutine.   This  subroutine  is  stored,  in  object  module  format, 
in  cataloged  library  HIS. OBJECT. 

CONVTRF  is  used  to  convert  a  Traffic  record  to  character  format  from  the 
internal  decimal  format,  and  vice  versa.   The  conversion  to  character  format 
is  used  when  listing  the  file  in  "dump"  format.   The  conversion  to  decimal 
format  is  used  when  updating  the  file. 

The  character  format  of  a  traffic  record  is  shown  in  Figure  2-III-4.   The 
decimal  format  of  a  record  is  shown  in  Figure  2-III-1. 

Rather  than  passing  structures,  data  is  passed  to  CONVTRF  in  character 
strings  of  length  104  and  80.   To  convert  from  character  to  decimal  format, 
code  CALL  CONVDEC  (CHAR, DEC) ;  to  convert  from  decimal  to  character  format, 
code  CALL  CONVPIC  (CHAR, DEC) ;  CHAR  is  declared  as  CHAR(104) ,  and  DEC  is  declared 
as  CHAR(80) . 

The  CONVTRF  program  listing  follows: 
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CHAR, 

2  DUMMY1 

2  KEY, 

3  ROUTE_SYSTEM 

3  ROUTE_NUMBER 

3  REFERENCE_POST 

3  DISTANCE  " 
2  ACTUAL_ESTIMATED_CODE 
2  DUMMY2 
2  FIRST_YEAR, 

3  YEAR 

3  AVERAGE_DAILY_TRAFFIC 

3  PERCENT_OUT_OF_STATE 

3  PERCENT_PICKUPS 

3   PERCENT_COMMERCIAL 
2   SECOND_YEAR 
2  THIRD_YEAR 
2   FOURTH_YEAR 
2   FUTUREJFACTOR 
2  DESIGN_HOUR_VOLUME 
2  REMARK 
2  DUMMY 3 
2  DATE_OF_UPDATE , 

3  YEAR 

3  MONTH 

3  DAY 


CHAR(l) , 

CHAR(l) , 
CHAR(3) , 
CHAR(3), 
CHAR(6) , 
CHAR(l) , 
CKAR(6) , 

CHAR(2) , 
CHAR(5) , 
CHAR(3), 
CHAR(3) , 
CHAR(3), 

LIKE  FIRST_YEAR, 
LIKE  FIRST_YEAR, 
LIKE  FIRST_YEAR, 
CHAR(3), 
CHAR (3) , 
CHAR(l) , 
CHAR(6) , 

CHAR(2) , 
CHAR(2) , 
CHAR(2) ; 


Figure  2-III-4.   Character  format  of  traffic  record. 


i 
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/*  TRAFFIC  CONVERSION  ROUTINE  */ 

l:  /*  TRAFFIC  CONVERSION  ROUTINE  */ 
2:  CCNVTRF:   PROCEDURE; 


3 

4 

5 

6 

7 

8 

9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 

21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 


/*  PICTURE  STRUCTURE  */ 
DECLARE 

OLDREC  CHAR (104) , 
1   SI  BASED  (PTR1), 
2   0UM1  CHAR(l), 
2   SYSTEM  CHAR(l), 
2  (RT_#,MPOST)  PIC'999% 
2   FRAC  PIC,«-9V.999I  , 
2   ACT_EST  CHAR( 1) , 
2   DUM  CHAR(6)f 
2   DATA(4), 

3   YR  PIC'ZZ*  , 
3   ADT  PIC'ZZZZZ' , 
3   X(3)  PIC»VZZZ«, 
2  (FUT,DHV)  PIC'VZZZ1, 
2   REMARK  CHAR(l), 
2   DUM2  CHAR(6) , 
2   DATE  CHARC6); 

/*  TRAFFIC  RECORD  */ 
DECLARE 

RECORD  CHAR(80), 

1   R  BASED  (PTR_REC) , 

2  (FILI, SYSTEM)  CHAR(l), 
2  (RT_#,MPOST)  PIC'999', 

2  frac  Pic'+gv^gg' , 

2  (RT,MP)  DEC  FIXED  (3,0), 
2   FR  DEC  FIXED  (5,3), 
2  (ACT_EST, REMARK)  CHAR(l), 
2   DATA(4), 

3   YR  DEC  FIXED  (3,0), 
3   ADT  DEC  FIXED  (5,0), 
3   X(3)  DEC  FIXED  (3,3), 
2  (FUT,DHV)  DEC  FIXED  (3,3), 
2   DATE  CHAR(6); 


37:  /*****  ENTRY  TO  CONVERT  PICTURE  STRUCTURE  TO  DECIMAL  *****/ 

38:  CONVDEC:   ENTRY  (OL DR EC, RECORD) ; 

39:     PTR1  =  ADDR(OLDREC); 
40:     PTR_REC  =  ADDR (RECORD ) ; 
41:     RECORD  =  •  • ; 
42:     R  =  SI,  BY  NAME; 
43:     R.RT  =  S1.RT_#; 
44:     R.MP  =  Sl.MPOST; 
45:     R.FR  =  SI. FRAC; 
46:     RETURN; 

47:  /*****  ENTRY  TO  CONVERT  DECIMAL  STRUCTURE  TO  PICTURE  STRUCTURE  *****/ 

48:  CONVPIC:   ENTRY  (OLDREC, RECORD) ; 
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/*  TRAFFIC  CONVERSION  ROUTINE  */ 


49:     PTR1  =  ADDR(OLDREC); 
50:     PTR_REC  =  ADDRCRECORD ) ; 
51:     OLOREC  =  •  • ; 
52:     SI  =  R,  BY  NAME; 
53:     RETURN; 

54:  END  CONVTRF; 
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Program  Descriptions 

Each  program  in  the  Traffic  and  True  Mileage  subsystem  is  stored  in  load 
module  format  in  cataloged  library  HIS.LOADLIB,  from  which  it  is  retrieved 
for  execution  by  the  HIS  supervisor  when  requested.   The  member  name  for  each 
program  is  given  with  the  program  description. 

This  section  of  the  manual  presents  a  write-up  on  each  program  in  the 
Traffic  and  True  Mileage  subsystem.   An  attempt  has  been  made  in  the  source 
listing  itself  to  document  the  programs  by  means  of  appropriate  variable 
names  and  comments. 

DUMP  (Traffic  file)  — 

Member  Name DMT 

Language PL/ 1 

Subroutines  PRINTX1 

CONVTRF 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  DUMP  output 
TRAFFIC   —  Traffic  file 

Instruction 1  -  3   "DMT" 

40  -  52  Beginning  key 
56  -  68  Ending  key 

DUMP  provides  an  unformatted  listing  of  data  in  the  Traffic  file,  between  user- 
specified  (by  means  of  the  DATA  parameter)  records  in  the  file.   Subroutine 
CONVTRF  is  used  to  convert  the  Traffic  records  into  character  format  for 
printer.   Subroutine  PRINTXl  is  used  for  printer  output,  allowing  the  use  of 
HIS  formatting  options  in  printing. 

The  DMT  program  listing  follows : 


-157- 


/*    TRAFFIC    FILE    DUMP    */ 

: 


1:  /*  TRAFFIC  FILE  DUMP  */ 

2:  DUMP:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 


3 
4 
5 
6 
7 
8 
9 
10 
11 


/*  INSTRUCTION  AND  PRINT  ROUTINE  */ 

DECLARE 

PARM  CHAR(IOO) , 
INSTR  CHAR(80)  EXT, 

STARTKEY  CHARI13)  DEF  INSTR  P0S(40), 
ENDKEY  CHARI13)  DEF  INSTR  P0S(56), 
#_HDGS  PIC'Z'  DEF  INSTR  P0S(72), 
(PRINTER, HEADINGC 9) )  CHAR(132)  EXT, 
PRINTX  ENTRY  (PIC1!1)  ; 


12:  /*  DATA  INPUT  */ 

13:  DECLARE 

14:     RECORD  CHAR(80)  BASEO  (PTR.TRF), 

15:     PRINT  CHARU04), 

16:     TRAFFIC  FIL£.B£CORD  KEYED  INPUT  SEQL  ENV  (INDEXED); 

c 

l7:  /*****  INITIALIZATION  *****/ 

18:     CALL  INIT  (PARM); 

19:     ^HDGS  =  2; 

20:     HEADING(l)  =  •  TRAFFIC  DUMP1; 

21:     OPEN  FILE  (TRAFFIC);  " 

22:  ON  ENDFILE  (TRAFFIC)  BEGIN; 

23:        PRINTER  =  •    END  OF  FILE.1; 

24:        CALL  PRINTX  (3);  •■ 

25:        GOTO  DONE; 

26:        END; 

27:     READ  FILE  (TRAFFIC)  SET  (PTR.TRF)  KEY  (STARTKEY);  B 

28:  /*****  EXECUTION  LOOP  *****/ 

» 

29:  LOOP: 

30:     CALL  CONVPIC  (PR  INT ,R ECORD) ; 

31:     PRINTER  =  PRINT;  , 

32:     CALL  PRINTX  (1); 

33:     READ  FILE  (TRAFFIC)  SET  (PTR_TRF); 

34:     IF  SU8STR(RECORD,2,13X=ENDKEY  THEN  GOTO  LOOP; 

i 

35:  DONE: 

36:     CLOSE  FILE  (TRAFFIC); 

37:     CALL  EXIT  (PARM);  • 


38:  END  DUMP; 


1 
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LIST  (Traffic  file)  — 

Member  Name PFT 

Language PL/ 1 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  --  LIST  output 

TRAFFIC  —  Traffic  file 

ROADLOG  —  Roadlog  file 

TRUMILE  —  True  Mileage  file 

Instruction 1  -   3  "PFT" 

40  -  52  Beginning  key 
56  -  68  Ending  key 

LIST  provides  a  listing  of  Traffic  data,  in  a  more  easily  read  formatted 
version  than  that  provided  by  DUMP.   In  addition  to  Traffic  data,  Roadlog 
descriptions  (at  major  section  breaks)  and  True  Mileage  data  is  also  listed, 
Data  Conversions  are  performed  within  LIST,  rather  than  by  CONVTRF.   LIST 
shows  only  three  years  of  data  (the  three  complete  years) .  To  view  the 
fourth  field,  DUMP  must  be  utilized. 
The  PFT  program  listing  follows: 
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/*  :LIST,FILE=TRAFFIC,DATA=XXXXX  */ 

r 

l:  /*  :LIST,FILE=TRAFFIC,DATA=XXXXX  */ 

2:  LIST:   PROCEDURE  (PARM)  OPTIONS  (MAIN);  r 


3:  /*****  VARIABLE  DECLARATIONS  (ALPHABETICAL  ORDER)  *****/ 


4 

5 

6 

7 

8 

9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 

21 

22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 


DECLARE 

#_HDGS  PIC'Z*  DEF  INSTR  P0S(72), 

ENDKEY  CHAR(16)  DEF  INSTR  P0S<56), 

F(0:9)  PIC'Z'  STATIC  INIT  (0,1,2,3,4,5,6,7,8,9), 

1   FTRF  STATIC, 

3   KEY  CHAR (13), 

3   DUMMY2  CHAR(l)  INIT  (•  •), 

3   TRUE_MILEAGE  P IC» ZZZV .ZZZ • , 

3   DUMMY3  CHAR(l)  INIT  (•  •), 

3   DESCR  CHAR(35), 

3   DUMMY5  CHAR(l)  INIT  (•  •), 

3   DATA(3), 

5   YEAR  PIC'ZZ1  , 

5   ADT  PIC»ZZZZZZ«, 

5  (OUT, PIC, COM)  PIC'ZZZZ1, 

5   DUMMY  CHAR(l)  INIT  (  •  •  ), 

3   FUT  PIC'ZZZ*  , 

3   DHV  PIC'ZZZZ1  , 

3   DUMMY7  CHAR(l)  INIT  (•  •), 

3   REMARK  CHAR(l), 

3   DUMMY8  CHAR(l)  INIT  (•  •), 
HEADING(9)  CHAR(132)  EXT, 
INSTR  CHAR(80)  EXT, 
PARM  CHAR( 100) , 
PRINTER  CHAR( 132)  EXT, 
I   RLG  BASED  (PTR_RLG), 

3   DUM1  CHAR(30), 

3   DESCR  CHAR(35), 
ROADLOG  FILE  RECORD  KEYED  ENV( INDEXED )  , 
STARTKEY  CHARU6)  DEF  INSTR  P0S(40), 
STRING_FTRF  CHAR(130)  DEF  FTRF, 
TRAFFIC  FILE  RECORD  KEYED  ENV( INDEXED) , 
1   TRM  STATIC, 

3   DUM1  CHAR(8), 

3   TRUE_MILEAGE  DEC  FIXED  (7,3), 

3   DUM2  CHAR(4) , 
1   TRF  BASED  (PTR.TRF), 

3   DUM1  CHAR( lT, 

3   KEY  CHAR(13), 

3   DUM5  CHAR(4) , 

3   FRACTION  DEC  FIXED  (5,3), 

3   ACT.EST  CHAR( 1) , 

3   REMARK  CHAR( 1), 

3   0ATA(3), 

5   YEAR  DEC  FIXEO  (3,0), 

5   ADT  DEC  FIXED  (5,0), 

5  (OUT, PIC, COM)  DEC  FIXEO  (3,0), 

3   DUM3  CHAR( 11) , 

3  (FUT, DHV)  DEC  FIXED  (3,0), 
TRUMILE  FILE  RECORD  KEYED  ENV( INDEXED ) ; 
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/*  :LIST,FILE=TRAFFIC,DATA=XXXXX  */ 

54:  /*****  PROGRAM  INITIALIZATION  *****/ 

55:  CALL  INIT  (PARM); 

56:  /***  SET  UP  COLUMN  HEADINGS  ***/ 

57:  #_HDGS  »  3; 

58:  HEADING(l)  =  •                 TRUE   •  I  I 

59:  «                                       ****  FIRST  YEAR  ****  •  II 

60:  •***  SECOND  YEAR  ****  ****  THIRD  YEAR  ****•; 

61:  HEADING(2)  =  <     KEY        MILEAGE  ■  II 

62:  ******   SECTION   DESCRIPTION   ******  YR   ADT   OUT  PIC  COM  *  I  I 

63:  'YR   ADT   OUT  PIC  COM  YR   ADT   OUT  PIC  COM  FUT  DHV«; 

64:  /***  DD  STATEMENTS  REQUIRED:   ROAOLOG,  TRAFFIC,  TRUMILE  ***/ 

65:  OPEN 

66:  FILE  (ROADLOG), 

67:  FILE  (TRAFFIC), 

68:  FILE  (TRUMILE); 

69:  ON  ENDFILE  (TRAFFIC)  GOTO  ^RETURN; 

70:  READ  FILE  (TRAFFIC)  SET  (PTR.TRF)  KEY  (STARTKEY); 

71:  ON  KEY  (ROADLOG)  RLG.DESCR  =  *****  ROAOLOG  RECORD  MISSING  ****•; 

72:  ON  KEY  (TRUMILE)  TRM.TRUE_MILEAGE  =  0; 

73:  #LOOP: 

74:  GOTO  PRNT_TRF; 

75:  REAO.TRF: 

76:  READ  FILE  (TRAFFIC)  SET  (PTR_TRF); 

77:  IF  TRF.KEY<=ENDKEY  THEN  GOTO  #LOOP; 

78:  tRETURN: 

79:  CLOSE 

80:  FILE  (ROADLOG), 

81:  FILE  (TRAFFIC), 

82:  FILE  (TRUMILE); 

83:  CALL  EXIT  (PARM)  ; 

84:  RETURN; 

85:  /*****  SUBROUTINE  TO  FORMAT  TRAFFIC  DATA  AND  PRINT  *****/ 

86:  PRNT.TRF: 

87:  STRING_FTRF  -  •  •; 

88:  /***  FORMAT  RECORD  INTO  STRUCTURE  FTRF  FOR  PRINTING  ***/ 

89:  FTRF  =  TRF,  BY  NAME; 

90:  IF  TRF.REMARK-.=  *S»  £  TRF.REMARK-=»  L»  &    TRF.  REMARK-.=  «  C»  THEN  DO; 

91:  READ  FILE  (TRUMILE)  INTO  (TRM)  KEY  (TRF. KEY); 

92:  FTRF.TRUE_MILEAGE  =  TRM.TRUE.M ILE AGE  +  FRACTION; 

93:  END; 

94:  IF  TRF.REMARK=«T»  I  TRF .REMARK=« W«  I 

95:  TRF.REMARK=,N«  |  TRF.REMARK=«Ol  I 

96:  TRF.REMARK=»S»  I  TRF. REMARK=«L •  I  TRF .REMARK=«C • 

97:  THEN  DO; 

98:  READ  FILE  (ROADLOG)  SET  (PTR_RLG)  KEY  (TRF. KEY); 

-161- 


/*  :LIST,FILE=TRAFFIC»DATA=XXXXX  */ 

99:  FTRF.DESCR  =  RLG.DESCR; 

100:  end; 

101 :  PRINTER  =  STRING_FTRF ; 

102:  CALL  PRINTX  <F<1)); 

103:  GOTO  READ_TRF; 

104:  END  LIST; 


n 
ri 

\ 

r  r 
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UPDATE  (Traffic  file)  —  UPDATE  is  comprised  of  four  separate  programs , 
one  for  each  of  the  functions  DELETE,  INSERT,  REWRITE,  and  NEW-KEY.   The  names 
of  the  routines  are  formed  by  the  letters  "PDT"  followed  by  the  first  letter 
of  the  function  ("D,"  "I,"  "R,"  or  "N") . 

FUNCTION=DELETE: 

Member  Name PDTD 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  UPDATE  output 

TRAFFIC  —  Traffic  file 

any  name  —  Traffic  data  cards 

Instruction 1  -  4   "PDTD" 

24  -  31  Name  of  input  DD  statement 

The  user  codes ,  by  means  of  the  DDNAME  parameter  on  the  UPDATE 
command,  the  name  of  the  DD  statement  he  will  supply  with 
deletion  data.   Each  card  read  via  this  DD  statement  contains, 
in  columns  1-13,  the  key  of  a  record  to  be  deleted.   The 
program  operates  with  a  direct  update  file;  each  time  a  card  is 
read,  a  PL/I  DELETE  statement  specifying  the  key  on  the  card  is 
executed.   If  the  key  condition  is  raised  (the  specified  record 
did  not  exist  in  the  file),  an  error  message  is  printed.   Each 
data  card  is  printed  as  it  is  read. 

The  PDTD  program  listing  follows: 


-163- 


/*  :UPDATE,FlLE=TRAFFIC,FUNCTION=DELETE,DDNAME=XXXXX  */ 

l:  /*  :UPDATE,FILE=TRAFFIC,FUNCTION=DELETE,DONAME=XXXXX  */ 

2:  DELETE:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 

3:  /*  INSTRUCTION  */ 

4:  DECLARE 

5:     INSTR  CHAR(80)  EXT, 

6:     #_HDGS  PIC'Z1  DEF  INSTR  POS(72), 

7:     DDNAME  CHAR(8)  DEF  INSTR  P0S(24); 

8:  /*  PRINT  ROUTINE  */ 

9:  DECLARE 
10:     PARM  CHARUOO)  , 

11:    (HEADING(9), PRINTER)  CHARU32)  EXT, 
12:     PRINTX  ENTRY  (PIC«Z»); 

13:  /*  PERMANENT  FILE  */ 

14:  DECLARE 

15:     PERMDD  CHAR<8)  STATIC  INIT  (•TRAFFIC1 )t 

16:     PERM  FILE  RECORD  KEYED  ENV  (INDEXED); 

17:  DECLARE 

18:     DATA  FILE  RECORD, 

19:     KEY  CHAR(80); 


20:    /*****    INITIALIZATION    *****/ 

21:  CALL    INIT    (PARM); 

22:  /*    SET    UP    HEADINGS    */ 

23:  #_HDGS    =    2; 

24:  HEADING(l)  =  PERMDD  II  'FILE  UPDATE  —  DELETION  OF  RECORDS1; 

25:  /*  OPEN  FILES  */ 

26:  OPEN  FILE  (OATA)  INPUT  RECORD  TITLE  (DDNAME); 

27:  ON  ENDFILE  (DATA)  GOTO  CLOSE; 

28:  OPEN  FILE  (PERM)  UPDATE  DIRECT  TITLE  (PERMDD); 

29:  ON  KEY  (PERM)  BEGIN; 

30:        PRINTER  =  • ***  RECORD  DOES  NOT  EXIST  IN  FILE1; 

31:        CALL  PRINTX  (1); 

32:        GOTO  READ. DATA; 

33:        END; 


34:  /*****  MAIN  EXECUTION  LOOP  *****/ 

35:  READ.DATA: 

36:     READ  FILE  (DATA)  INTO  (KEY); 

37:     IF  SUBSTR( KEY, 8, !)-=•♦•  THEN  SUBSTR ( KEY, 8 ,6 )  =  •♦0.'  I  I 

38:         SUBSTR(KEY,8,2)  II  «0»; 

39:     PRINTER  =  •       •  I  I  KEY; 

40:     CALL  PRINTX  (2); 

41:     DELETE  FILE  (PERM)  KEY  (KEY); 

42:     GOTO  READ_DATA; 

43:  CLOSE: 

44:  CLOSE  FILE  (PERM); 
45:  CLOSE  FILE  (DATA) ; 
46:     CALL  EXIT  (PARM) ; 
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/*    :UPDATE,FILE=TRAFFIC.FUNCTION=DELETE,DDNAME=XXXXX    */ 

47:  RETURN: 
48:  END  DELETE; 
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FUNCTION= INSERT : 

Member  Name PDTI 

Language PL /I 

Subroutines  PRINTX1 

CONVTRF 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  UPDATE  output 

TRAFFIC  —  Traffic  file 

any  name  —  Traffic  data  cards 

Instruction 1  -  4  "PDTI" 

24  -  31  Name  of  input  DD  statement 

Data  cards,  when  inserting  records,  contain  a  complete  record. 
The  only  fields  that  are  essential  in  all  Traffic  records  are 
the  key  field  and  the  remark  field.   Both  of  the  Traffic  data 
cards  have  spaces  for  the  key,  the  remark,  and  the  design  hour 
volume.  Hence,  either  a  first  card,  a  second  card,  or  a 
first  card-second  card  sequence  may  be  coded  for  a  record 
when  inserting.   If  both  cards  are  supplied,  each  must  contain 
the  key.   Subroutine  CONVTRF  converts  the  data  cards  into  the 
Traffic  decimal  format. 

The  PDTI  program  listing  follows : 
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/*  :UPDATE,FILE=TRAFFIC,FUNCTION=INSERT,DDNAME=XXXXX  */ 

l:  /*  :UPDATE,FILE=TRAFFIC,FUNCTION=INSERT,DDNAME=XXXXX  */ 

2:  INSERT:   PROCEOURE  CPARM)  OPTIONS  (MAIN); 

3-:  /*  INSTRUCTION  AND  PRINT  ROUTINE  */ 

4:  DECLARE 

5:     PARM  CHAR (100), 

6:     INSTR  CHAR(80)  EXT, 

7:     DDNAME  CHAR(8)  DEF  INSTR  P0S(24), 

8:    ( PRINTER, HEADING(9))  CHARI132)  EXT, 

9:     PRINTX  ENTRY  (PIC'ZM; 

10:  /*  DATA  INPUT  */ 

11:  DECLARE 

12:     OLDREC  CHARU04)  , 

13:     C(104)  CHAR(l)  DEF  OLDREC, 

14:     CARD  CHAR(80) , 

15:     CA(80)  CHAR(l)  DEF  CARD, 

16:     DATA  FILE  RECORD  SEQL  INPUT; 

17:  /*  TRAFFIC  FILE  */ 

18:  DECLARE 

19:     RECORD  CHAR(80), 

20:     TRAFFIC  FILE  RECORD  DIRECT  UPDATE  KEYED  ENV  (INDEXED); 

21:  /*  OTHER  VARIABLES  */ 

22:  DECLARE 

23:     FLAG  CHAR(l) , 

24:     KEEP_DATE  CHAR(6); 

25:  /*****  INITIALIZATION  *****/ 


26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 
39 


CALL  INIT  (PARM); 

#_HDGS  =  2; 

HEADING(l)  =  •       TRAFFIC  UPDATE  —  FUNCTI 0N= INSERT* ; 

OPEN 

FILE  (DATA)  TITLE  (DDNAME), 

FILE  (TRAFFIC); 
ON  KEY  (TRAFFIC)  BEGIN; 

PRINTER  =  •***  ATTEMPT  TO  INSERT  OVER  EXISTING  RECORD1; 

CALL  PRINTX  (1); 

GOTO  read_data; 

END; 
ON  ENDFILE  (DATA)  FLAG  =  «X«; 
FLAG  =  • A" ; 
KEEP.OATE  *  DATE; 


40:  /*****  EXECUTION  LOOP  *****/ 

41:  READ_DATA: 

42:  IF    FLAG='A'     THEN    READ    FILE    (DATA)     INTO    (CARD); 

43:  IF    FLAG='X'    THEN    GOTO    DONE; 

44:  FLAG    =    • A» ; 

45:     PRINTER  =  (5)«  •  I |  CARD; 

46:     CALL  PRINTX  (2); 

47:     IF  CA(1)=,P  I  CA(1)««P«  I  CA(1)=«S»  THEN  GOTO  CAR0_1; 
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/*  :UPDATE,FILE=TRAFFIC,FUNCTION=INSERT,DDNAME=XXXXX  */ 

48:  IF  CA(1)  =  «C'  THEN  GOTO  CARD_2; 

49:  PRINTER  =  • ***  UNKNOWN  CHARACTER  IN  COLUMN  i« ; 

50:  CALL  PRINTX  (1); 

51:  GOTO  READ_DATA; 


52 
53 
54 
55 
56 
57 
58 
59 
60 
61 
62 
63 
64 
65 
66 
67 
68 
69 
70 
71 
72 
73 
74 
75 


CARD_l: 

THEN  OLDREC  =  •  •  II  SUBSTR (CARD, 1 ,68 )  II  ( 16) •  •  II 
SUBSTRICARD.69); 

ELSE  OLDREC  =  •  •  II  SUBSTRt CARD, 1 ,7)  II  •♦0.«  II 
SUBSTR(CARD,8,2)  II  f0»  II  SUBSTR( CARD, 1 0,7 )  II 
SUBSTR(CARD,21,48)  II  (16)'  ■  II  SUBSTRt CARD, 69) ; 
READ  FILE  (OATA)  INTO  (CARD); 

IF  CA(1)=»C«  L 

(CA(9)=»*'  £  SUBSTR(CARD,2,13)=SUBSTR(0LDREC,2,13>  I 
CA(9)^,-»••  €  SUBSTR(CARD,2,9)=SUBSTR(0LDREC,2,9)) 

THEN  DO; 

PRINTER  =  (5) ■  •  II  CARD; 

CALL  PRINTX  (1); 

IF  C(9)^=«+»  THEN  CARD  =  SUBSTRI CARD, 1 ,8 )  II  •♦0.«  I 

SUBSTR(CARD,9,2)  II  «0«  II  SUBSTR( CARD, 1 1 ) ; 
SUBSTR(0LDREC,76,16)  =  SUBSTR(C ARD, 15 , 16) ; 
IF  SUBSTR(CARD, 31, !)-•*•  * 

THEN  SUBSTR(GLDREC, 92,1)  =  SUBSTR(CARD ,31 , 1 ) ; 
IF  SUBSTR(CARD,32,3)-.=  «  * 

THEN  SUBSTR(0LDREC,89,3)  =  SUBSTR(CARD, 32 ,3 ) ; 
END; 
ELSE  IF  FLAG-^'X'  THEN  FLAG  =  'B1; 
GOTO  TEST^NUMERICS; 


76:  CARD_2: 

77:  IF  CA<2)-.=  'I«  €  CA<2)^='P»  &  CA(2)-='S«  THEN  DO; 

78:         PRINTER  =  •***  UNKNOWN  CHARACTER  IN  COLUMN  2»; 

79:        CALL  PRINTX  (1); 

80:         GOTO  READ.DATA; 

81 :         END; 

82:  IF  CA(9)-.=  ,+l 

83:        THEN  CARD  =  SUBSTR(CARD, 1,8)  II  •♦O.'  II  SUBSTR (C ARD, 9 ,2)  II 

84:  '0*     II  SUBSTR(CARD,11) ; 

85:  OLDREC  =  '  •  II  SUBSTR( CARD, 2, 13 )  II  ( 55) •  «  II  SUBSTR(CAPD, 15 , 1 6) 

86:         ||  (3)«  •  II  SUBSTR(CARD,32,3)  II  SUBSTR (CARD, 31 , 1) ; 

87:  TEST_NUMERICS: 

88:  DO  1=3  TO  8,10,12  TO  14,21  TO  91; 

89:        IF  (CIIK'O'  I  C(I)>*9«)  I    C(l)-.=  »  ■  THEN  DO; 

90:  PRINTER  =  •***  NON-NUMERIC  CHARACTER  IN  NUMERIC  FIELD'; 

91:  CALL  PRINTX  (1); 

92:  GOTO  READ_DATA; 

93:  END; 

94:         END; 

95:  IF  C(92)-»=,TI  fc  C(92)-.=  »W«  &  C(92)-=,NI  £  C(92)-»=,0I  £ 

96:        C(92)-=,C»  L    C(92)-*=,S»  &  CI92l-i«,Ll  £  CC92)-as,Rl  £ 

97:        0(92)^=^'  THEN  DO; 

98:         PRINTER  =  •***  INVALID  REMARK 

99:        CALL  PRINTX  (1); 
100:        GOTO  READ.DATA; 
101:        END; 

102:  CALL  CONVDEC  (OLDREC, RECORD) ; 
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/*  :UPDATE,FILE=TRAFFIC,FUNCTION=INSERT,DDNAME=XXXXX  */ 

103:     SUBSTR(RECORD»74>  =  KEEP.DATE; 

104:     WRITE  FILE  (TRAFFIC)  FROM  (RECORD)  KEYFROM  ( SUBSTR1 RECORO, 2 ) ) ; 

105:     GOTO  READ_DATA; 

1065  DONE: 

107:     PRINTER  =  ■    END  OF  DATA.*; 

108:     CALL  PRINTX  (3); 

109:     CLOSE  ,. 

110:        FILE  (TRAFFIC), 

111:        FILE  (DATA); 

112:     CALL  EXIT  (PARM) ; 

113:  END  INSERT; 
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FUNCTION=REWRITE; 

Member  Name PDTR 

Language PL/I 

Subroutines  PRINTX1 

CONVTRF 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  UPDATE  output 

TRAFFIC  —  Traffic  file 

any  name  —  Traffic  data  cards 

Instruction 1  -  4  "PDTR" 

24  -  31  Name  of  input  DD  statement 

When  rewriting,  data  cards  need  contain  only  the  key  and  the 
fields  which  are  being  altered  (FUNCTION=REWRITE  cannot  alter 
the  key).   Either  a  first  card,  a  second  card,  or  a  first 
card-second  card  sequence  may  be  supplied  for  each  record 
rewritten.   CONVTRF  is  used  for  converting  the  specified 
record  into  character  format.   The  record  is  then  compared 
to  the  data  cards,  and  all  non-blank  fields  on  the  data  cards 
copied  into  the  record  (dollar  signs  first  being  replaced 
with  blanks) .   The  resultant  record  is  then  converted  into 
the  Traffic  decimal  format  (by  CONVTRF) ,  and  a  PL/I  REWRITE 
statement  used  to  replace  the  record. 
The  PDTR  program  listing  follows: 
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/*  :UPDATE,FILE=TRAFFIC,FUNCTION=REWRITE,DDNAME=XXXXX  */ 

l:  /*  :UPDATE,FILE=TRAFFIC, FUNCT ION=REWR I TEt DONAME=XXXXX  */ 

2:  REWRITE:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 

3:  /*  INSTRUCTION  AND  PRINT  ROUTINE  */ 

4:  DECLARE 

5:  PARM  CHAR(IOO), 

6:  INSTR  CHARC80)  EXT, 

7:  DDNAME  CHAR(8)  DEF  INSTR  P0S(24), 

8:  #_HDGS  PI^Z*  DEF  INSTR  P0S(72)» 

9:  (PRINTER, HEADINGC9H  CHAR(132)  EXT, 

10:  PRINTX  ENTRY  <PIC»Z«); 


11 

12 
13 
14 
15 
16 
17 
18 
19 


/*  DATA  INPUT  */ 
DECLARE 

GETREC  CHAR(104), 

6(104)  CHAR(l)  DEF  GETREC, 

OLDREC  CHAR(104), 

C(104)  CHAR(l)  DEF  OLDREC, 

CARD  CHAR(80) , 

CA(80)  CHAR(l)  DEF  CARD, 

DATA  FILE  RECORD  SEQL  INPUT; 


20:  /*  TRAFFIC  FILE  */ 

21:  DECLARE 

22:     RECORD  CHAR (80) , 

23:     TRAFFIC  FILE  RECORD  DIRECT  UPDATE  KEYED  ENV  (INDEXED); 

24:  /*  OTHER  VARIABLES  */ 

25:  DECLARE 

26:     KEEP_DATE  CHAR(6); 


27:  /*****  INITIALIZATION  *****/ 

28:  CALL  INIT  (PARM); 

29:  #_HDGS  =  2; 

30:  HEADING(l)  =  "       TRAFFIC  UPDATE  —  FUNCTION=REWRI TE • ; 

31:  OPEN 

32:        FILE  (DATA)  TITLE  (DDNAME), 

33:         FILE  (TRAFFIC); 

34:  ON  KEY  (TRAFFIC)  BEGIN; 

35:         PRINTER  =  •***  NO  RECORD  FOR  ATTEMPTED  REWRITE*; 

36:        CALL  PRINTX  (1) ; 

37:  GOTO    READ_DATA; 

38:  END; 

39:  ON  ENDFILE  (DATA)  GOTO  DONE; 

40:  KEEP_DATE  =  DATE; 


41:  /*****  EXECUTION  LOOP  *****/ 

42:  READ.DATA: 

43:     READ  FILE  (DATA)  INTO  (CARD); 

44:     PRINTER  =  (5)«  ■  II  CARD; 

45:     CALL  PRINTX  (2); 

46:     IF  CAI1I-M*  I  CAd^'P1  I  CACll-'S'  THEN  GOTO  CARD.l; 

47:  IF    CAdl^C     THEN    GOTO   CARD_2; 
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/*  :UPDATE,FILE=TRAFFIC,FUNCTION=REWRITE,DDNAME=XXXXX  */ 

48:  PRINTER  =  •***  UNKNOWN  CHARACTER  IN  COLUMN  I" ; 

49:  CALL  PRINTX  (1); 

50:  GOTO  READ.DATA; 

51:  CARD_l: 

52:  IF  CA(8)>'4-« 

53:  THEN  OLDREC  =  •  •  II  SUBSTRICARD, 1 ,68 )  II  (  16) •  •  I  I 

54:  SUBSTR(CARD,69) ; 

55:  ELSE  OLDREC  =  •  •  II  SUBSTRICARD, 1 ,7)  II  •♦O.'  II 

56:  SUBSTR(CARD,8,2)  II  «0«  II  SUBSTR! CARD, 1 0,7 )  II 

57:  SUBSTR(CARD,21,48)  | |  (16)«  •  II  SUBSTR( C ARD ,69) ;              J 

58:  GOTO  GET_RECORD; 

i 

59:  CARD_2: 

60:  IF  CA(2l^»vIa  £  CA(2)-^=,PI  &  CA(2)->=,S«  THEN  DO; 

61:  PRINTER  =  •***  UNKNOWN  CHARACTER  IN  COLUMN  2»; 

62:  CALL  PRINTX  (1); 

63:  GOTO  READ.DATA; 

64:  END; 

65:  IF  CA(9)-.=  »+« 

66:  THEN  CARD  =  SUBSTR (CARD, 1 , 8 )  I  I  •♦O."  II  SUBSTR(C ARD,9 ,2)  II 

67:  »Oa  II  SUBSTR(CARD,ll)  ; 

68:  OLDREC  =  •  •  II  SUBSTR(CARD, 2, 13)  I  I  ( 55) •  •  II  SUBSTR (CARD, 15 ,16) 

69:  ||  I  31 •  -•  II  SUBSTR(CARD,32,3)  II  SUBSTR (CARD, 31 , 1 ) ; 


79 

80 
81 
82 
83 
84 
85 
86 
87 
88 
89 
90 
91 
92 
93 
94 
95 
96 
97 


: 


70:  GET.RECORD: 

71:  READ  FILE  (TRAFFIC)  INTO  (RECORD)  KEY  ( SUBSTR( OLDREC ,2 )) ; 

72:  CALL  CONVPIC  (GETREC, RECORD ) ; 

73:  DO  1=15  TO  104; 

74:        IF  C(Ih='  •  THEN  DO; 

75:  IF  C(I)=«$«  THEN  C(I)  =  •  •; 

76:  G(I)  =  C(I); 

77:  END; 

78:        END; 


: 


: 


/*  TEST  NUMERIC  FIELDS  */ 

DO  1=3  TO  8,10,12  TO  14,21  TO  91;  ■ 

IF  IGIIK'O'  I  G(I)>»9»)  &  G(I)-.=  «  ■  THEN  DO; 

PRINTER  =  •***  NON-NUMERIC  CHARACTER  IN  NUMERIC  FIELD'; 

CALL  PRINTX  (1); 

GOTO  read_data; 

END; 

end; 

IF  G(92)-.=  »T»  L    G(92)^,W«  &  G(92)-.=  ,N«  £  G(92)-.=  a0»  & 

G(92)-»=aCa  &  G(92)^«S*  I    G(92)-*=»L»  £  G(92)-=aR»  & 

G(92)-.=  »M»  THEN  DO; 

PRINTER  =  •***  INVALID  REMARK  CODE1; 

CALL  PRINTX  (1); 

GOTO  READ_DATA; 

END; 
CALL  CONVDEC  ( GETR EC, RECORD ) ; 
SUBSTR(REC0RD,74)  =  KEEP_DATE; 

REWRITE  FILE  (TRAFFIC)  FROM  (RECORD)  KEY  ( SUBSTR ( RECORD, 2 )) ; 
GOTO  READ.DATA; 


98:  DONE: 

99:     PRINTER  =  •    END  OF  DATA.* 
100:     CALL  PRINTX  (3); 
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/*  :UPDATEt FILE=TRAFF IC.FUNCT ION^REWRITE, DDNAME=XXXXX  */ 

101:  CLOSE 

102:        FILE  (TRAFFIC!, 
103:        FILE  (DATA); 

104:  CALL  EXIT  (PARM); 

105:  END  REWRITE; 
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FUNCTION=NEW-KEY ; 

Member  Name PDTN 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  UPDATE  output 

TRAFFIC  —  Traffic  file 

any  name  —  Traffic  data  cards 

Instruction 1  -  4  "PDTN" 

24  -  31  Name  of  input  DD  statement 

The  NEW-KEY  function  allows  alteration  of  the  key  field,  which 
cannot  be  altered  by  REWRITE.   Upon  reading  a  data  card  (con- 
taining the  existing  key  in  columns  1-13,  and  the  new  key  in 
columns  15-27) ,  the  program  first  checks  to  be  sure  that  no 
record  already  exists  with  the  new  key,  then  reads  the  existing 
record,  supplies  the  new  key,  inserts  the  record,  and  deletes 
the  old  record.   An  error  message  is  generated  either  if  a 
record  already  exists  with  the  new  key,  or  if  no  record  exists 
with  the  old  key. 

The  PDTN  program  listing  follows: 
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/*  :UPDATE,FILE=TRAFFIC,FUNCTION_NEW-KEY,DATA=XXXXX  */ 

l:  /*  :UPDATE,FILE=TRAFFIC,FUNCTION_NEW-KEY,DATA=XXXXX  */ 

2:  NEWKEY:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 

3:  /*  INSTRUCTION  */ 

4:  DECLARE 

5:     INSTR  CHAR(80)  EXT, 

6*.     DDNAME  CHAR<8)  DEF  INSTR  POS(24), 

7:     #_HDGS  PIC^Z'  DEF  INSTR  POS(72); 

8:  /*  PRINT  ROUTINE  */ 

9:  DECLARE 
10:     PARM  CHAR(IOO) , 

11:    (HEADINGI9), PRINTER)  CHAR(132)  EXT, 
12:     PRINTX  ENTRY  (PIC»Z»), 
13:     PRINTXA  ENTRY  (PIC • I*  ,P IC» ZZ • ) ; 

14:  /*  PERMANENT  FILE  */ 

15:  DECLARE 

16:     RECORD  CHAR(80)  STATIC, 

17:     1   R  DEF  RECORD, 

18:        3   DUM1  CHAR(l), 

19:         3   KEY  CHAR(13)  , 

20:     PERMDD  CHAR(8)  STATIC  INIT  (•TRAFFIC*), 

21:     PERM  FILE  RECORD  KEYED  ENV  (INDEXED); 

22:  /*  DATA  INPUT  */ 

23:  DECLARE 

24:     CARD  CHAR(80)  BASED  (PTR.DATA), 

25:     1   C  BASED  (PTR_DATA), 

26:        3   OLD  CHAR(13), 

27:        3   DUM  CHAR(l) , 

28:         3   NEW  CHAR(13) , 

29:     DATA  FILE  RECORD; 

30:  /*****  INITIALIZATION  *****/ 

31:     CALL  INIT  (PARM); 

32:     #_HDGS  =  2; 

33:     HEADING(l)  =  PERMDD  I  I  'FILE  UPDATE  —  NEW  KEY'; 

34:     /*  INIT  FILES  */ 

35:     ON  UNDEFINEDFILE  (DATA)  BEGIN; 

36:         PRINTER  =  •***  •  ||  DDNAME  | |  •  DD  STATEMENT  MISSING' 

37:        CALL  PRINTX  (3); 

38:        GOTO  RETURN; 

39:        END; 

40:     OPEN  FILE  (DATA)  INPUT  RECORD  TITLE  (DDNAME); 

41:     OPEN  FILE  (PERM)  UPDATE  DIRECT  TITLE  (PERMDD); 

42:     ON  ENDFILE  (DATA)  GOTO  FINISH; 

43:  /*****  MAIN  EXECUTION  LOOP  *****/ 

44:  READ_DATA: 

45:     REAO  FILE  (DATA)  SET  (PTR.DATA) ; 

46:     PRINTER  ■  •       '11  CARD; 
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/*  :UPDATE, FILE=TRAFF IC, FUNCT ION.NEW-KE Y,DATA=XXXXX  */ 

47:  CALL  PRINTXA  (3,7); 

48:  ON  KEY  (PERM)  GOTO  GET_RECORD; 

49:  READ  FILE  (PERM)  INTO  (RECORO)  KEY  (C.NEW); 

50:  PRINTER  =•***  ATTEMPT  TO  INSERT  OVER  EXISTING 

51:  CALL  PRINTX  (1); 

52:  GOTO  READ.DATA; 

53:  GET.RECORO.: 

54:  ON  KEY  (PERM)  BEGIN; 

55:  PRINTER  =  •***  RECORD  DOES  NOT  EXIST  IN  FILE1; 

56:  CALL  PRINTX  (1); 

57:  GOTO  READ.DATA; 

58:  END; 

59:  READ  FILE  (PERM)  INTO  (RECORD)  KEY  (COLD); 

60:  R.KEY  =  C.NEW; 

61:  WRITE  FILE  (PERM)  FROM  (RECORD)  KEYFROM  (R.KEY); 

62:  DELETE  FILE  (PERM)  KEY  (COLD); 

63:  GOTO  READ__DATA; 

64:  FINISH: 

65:  PRINTER  =  •   END  OF  DATA*; 

66:  CALL  PRINTX  (3); 

67:  CLOSE  FILE  (PERM); 

68:  CLOSE  FILE  (OATA); 

69:  RETURN: 

70:  CALL  EXIT  (PARM); 

71:  END  NEWKEY; 
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UPDATE-BY -YEAR  (Traffic  file)  — 

Member  Name PGT 

Language PL/ 1 

Subroutines none 

Files  SYSPRINT  —  IBM  and  UPDATE-BY-YEAR  output 

TRAFFIC  —  Traffic  file 

Instruction 1-  3   "PGT" 

UPDATE-BY-YEAR  goes  through  the  Traffic  file,  and  shifts  the  data  one  year;  it 
must  be  executed  yearly  after  the  fourth  data  year  has  been  filled  in.   The 
first  record  of  the  Traffic  file  (key  "A000")  contains  the  years  for  the  file; 
this  record  is  also  updated  by  adding  one  to  each  year. 
The  PGT  program  listing  follows : 
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/*  :UPDATE-BY-YEAR,FILE=TRAFFIC  */ 

l:  /*  :UPDATE-BY-YEAR,FILE=TRAFFIC  */ 
2:  UPDYR:   PROCEDURE  OPTIONS  (MAIN); 


3 

4 

5 

6 

7 

8 

9 

10 

11 

12 


DECLARE 

TRAFFIC  FILE  INT  RECORD  KEYED  UPDATE  ENV  (INDEXED), 
YR(4)  PIC«ZZ«  DEF  TRF  P0S(15), 
TXPOS  CHAR(l)  DEF  TRF  P0S(57), 
1   TX  BASED  (PTR), 

2   YEAR  DEC  FIXED  (3,0) , 

2   ADT  DEC  FIXED  (5,0), 

2  (A,B,C)  DEC  FIXED  (3,0), 
TRF  CHAR(80)  STATIC, 
DTE  CHAR(6); 


13:  /*  INIT  VAR  */ 

14:     DTE  =  DATE; 

15:     OPEN  FILE  (TRAFFIC); 

16:     PTR  =  AODR(TXPOS); 

17:     ON  ENDFILE  (TRAFFIC)  GOTO  STOP; 

18:  /*  FIRST  RECORD  CONTAINS  DATA  YEARS  */ 

19:     READ  FILE  (TRAFFIC)  INTO  (TRF); 

20:     DO  1=1  TO  4; 

21:       YR(I)  =  YR(I)  ♦  l; 

22:        END; 

23:     REWRITE  FILE  (TRAFFIC)  FROM  (TRF); 

24:  /*  EXECUTION  LOOP  */ 

25:  LOOP: 

26:     READ  FILE  (TRAFFIC)  INTO  (TRF); 

27:     SUBSTR(TRF, 24,33)  =  SUBSTR ( TRF , 35 ,33) ; 

28:     TX  =  0; 

29:     SUBSTR(TRF,72,6)  =  DTE; 

30:     REWRITE  FILE  (TRAFFIC)  FROM  (TRF); 

31:     GOTO  LOOP; 

32:  STOP: 

33:     CLOSE  FILE  (TRAFFIC); 

34:     PUT  FILE  (SYSPRINT)  SKIP  EDIT 

35:         ('UPDATE-BY-YEAR  SUCCESSFULLY  COMPLETED1 )  (A) 

36:  END  UPDYR; 
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COPY  (Traffic  file)  — 

Member  Name PBT 

Language PL/I 

Subroutines  PRINTX1 

CONVTRF 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  COPY  output 
TRAFFIC  —  Traffic  file 
SAVETRF  —  Backup  copy  (output) 

Instruction 1  -  3  "PBT" 

5   "Y'V'N"  for  LIST=YES/LIST=NO 

COPY  prepares  a  backup  copy  of  the  Traffic  file.   The  backup  copy  is  a 
sequential  version  of  the  Traffic  file,  with  identical  record  length  (80 
characters).   A  dummy  record  containing  the  date  is  first  written.   This 
record  is  followed  by  each  of  the  Traffic  records.   If  LIST=YES  is  specified, 
CONVTRF  is  used  to  convert  the  records  into  character  format,  and  the  records 
listed  in  "dump"  format  (identical  to  that  produced  by  DUMP).   A  count  is 
taken  of  the  number  of  records  in  the  file.   The  count  is  printed  after  the 
last  record  is  written. 

The  PBT  program  listing  follows: 


-179- 


/*  :COPY,FILE=TRAFFIC,LIST=XXXXX  */ 

l:  /*  :COPY,FILE=TRAFFIC,LIST=XXXXX  */ 

2:  COPY:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 

3.*  /*  INSTRUCTION  */ 

4:  DECLARE 

5:     INSTR  CHARC80)  EXT, 

6:     LIST  CHAR(l)  DEF  INSTR  POS(5), 

7:     #_HDGS  PIC'Z1  DEF  INSTR  POSI72); 

8:  /*  PRINT  ROUTINE  */ 

9:  DECLARE 
10:     PARM  CHAR(IOO) , 

ll:    (HEADING(9), PRINTER)  CHAR(132)  EXT, 
12:     PRINTX  ENTRY  (PIC'ZM; 

13:  /*  FILES  */ 

14:  DECLARE 

15:     RECORD  CHAM80)  BASED  (  PTR  ) , 

16:     R  CHAR! 104), 

17:     BACKDD  CHAR(8I  STATIC  INIT  ('SAVETRFM, 

18:     PERMDD  CHAR(8)  STATIC  INIT  (•TRAFFIC1), 

19:     PERM  FILE  RECORD  KEYED  ENV  (INDEXED), 

20:     BACKUP  FILE  RECORD; 

21:  /*  OTHER  VARIABLES  */ 

22:  DECLARE 

23:     UD  CHAR(6)  , 

24:     CNTR  BIN  FIXED  (31), 

25:     PCNTR  PIC»ZZZZZ9«; 

26:  /*****  INITIALIZATION  *****/ 

27:     CALL  INIT  (PARM); 

28:     /*  SET  UP  HEADINGS  */ 

29:     #_HDGS  =  2; 

30:     HEADING(l)  =  PERMDD  I  I  'FILE  COPY  ROUTINE1; 

31:     /*  INIT  FILES  */ 

32:     OPEN  FILE  (PERM)  INPUT  TITLE  (PERMDD); 
33:     OPEN  FILE  (BACKUP)  OUTPUT  TITLE  (BACKDD); 
34:     ON  ENDFILE  (PERM)  GOTO  DONE; 

35:     /*  RECORD  DATE  */ 

36:     UD  =  DATE; 

37:     PTR  =  ADDR(R) ; 

38:     RECORD  =  SUBSTR ( UD, 3, 2)  II  •/■  II 

39:  SUBSTR(UD,5,2)  I  I  •/■  II  SUBSTR (UD, 1 ,2 )  ; 

40:     WRITE  FILE  (BACKUP)  FROM  (RECORD); 


41:  /*****  MAIN  EXECUTION  LOOP  *****/ 

42:     DO  CNTR=1  TO  999999; 

43:         READ  FILE  (PERM)  SET  (PTR); 

44:         WRITE  FILE  (BACKUP)  FROM  (RECORD); 
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/*  :COPY,FlLE=TRAFFIC,LIST=XXXXX  */ 

45:  IF  LIST=,Y«  THEN  DO; 

46:  CALL  CONVPIC  (RECORD, R); 

47:  PRINTER  =  R; 

48:  CALL  PRINTX  (1); 

49:  END; 

50:  END; 

51:  DONE: 

52:  PCNTR  =  CNTR  -  IS 

53:  PRINTER  =  'NUMBER  OF  RECORDS  IN  FILE:   •  II  PCNTR 

54:  CALL  PRINTX  (3); 

55:  CLOSE  FILE  (PERM); 

56:  CLOSE  FILE  (BACKUP); 

57:  CALL  EXIT  (PARM); 

58:  END  COPY; 
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CREATE  (Traffic  file)  — 

Member  Name PAT 

Language PL/ 1 

Subroutines  PRINTX1 

CONVTRF 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  CREATE  output 
TRAFFIC  —  Traffic  file  (output) 
SAVETRF  —  Backup  copy 

Instruction 1  -  3  "PAT" 

5   "Y"/"N"  for  LIST=YES/LIST=NO 

CREATE  restores  the  Traffic  file  from  a  backup  copy  saved  via  program  COPY. 
The  first  record  in  the  file  is  a  dummy  record,  containing  the  date  on  which 
the  file  was  copied.   This  date  is  printed  prior  to  performing  the  create 
operation.   After  printing  the  date,  the  records  are  read  from  the  backup 
copy  and  written  into  the  Traffic  file,  destroying  the  previous  file.   If 
LIST=YES  is  specified,  subroutine  CONVTRF  is  used  to  convert  the  records  to 
character  format  for  printing.   As  with  COPY,  the  records  are  counted  as  they 
are  written.   The  count  is  printed  after  the  create  operation  is  complete. 
The  PAT  program  listing  follows: 
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/*  :CREATE,FILE=TRAFFIC,LIST=XXXXX  */ 

l:  /*  :CREATE,FILE=TRAFFIC,LIST=XXXXX  */ 

2:  CREATE:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 

3:  /*  INSTRUCTION  */ 

4:  DECLARE 

5:     INSTR  CHARC30)  EXT, 

6:     LIST  CHAR(l)  DFF  INSTR  POS(5), 

7:     #_HDGS  PIC'Z1  DEF  INSTR  POSI72); 

8:  /*  PRINT  ROUTINE  */ 

9:  DECLARE 
10:     PARM  CHAR(IOO), 

11:    (HEADING(9>, PRINTER)  CHARU32)  EXT, 
12:     PRINTX  ENTRY  (PIC'ZM; 

13:  /*  FILES  */ 

14:  DECLARE 

15:     RECORD  CHAR(104)  BASED  (PTR), 

16:     BACKDD  CHAR(8)  STATIC  INIT  ('SAVETRFM, 

17:     PERMDD  CHAR(8)  STATIC  INIT  ('TRAFFIC1), 

18:     PERM  FILE  RECORD  KEYED  ENV  (INOEXED), 

19:     BACKUP  FILE  RECORD; 

20:  /*  OTHER  VARIABLES  */ 

21:  DECLARE 

22:  CNTR  BIN  FIXED  (31)  , 

23:     PCNTR  PICZZZZZ9'; 

24:  /*****  INITIALIZATION  *****/ 

25:     CALL  INIT  (PARM); 

26:  /*    SET    UP    HEADINGS    */ 

27:  #_HDGS    =    2; 

28:     HEADING(l)  =  PERMDD  II  'FILE  CREATION  ROUTINE1; 

29:     /*  INIT  FILES  */ 

30:     OPEN  FILE  (BACKUP)  INPUT  TITLE  (BACKOD); 
31:     OPEN  FILE  (PERM)  OUTPUT  TITLE  (PERMDD); 
32:     ON  ENDFILE  (BACKUP)  GOTO  DONE; 

33:     /*  PRINT  DATE  */ 

34:     REAO  FILE  (BACKUP)  SET  (PTR); 

35:     PRINTER  =  ■    DATE  OF  BACKUP  FILE  IS  •  II  RECORD; 

36:     CALL  PRINTX  (1) ; 

37:     PRINTER  =  •  • ; 

38:     CALL  PRINTX  (1); 

39:  /*****  MAIN  EXECUTION  LOOP  *****/ 

40:     DO  CNTR=1  TO  999999; 

41:        READ  FILE  (BACKUP)  SET  (PTR); 

42:        WRITE  FILE  (PERM)  FROM  (RECORD)  KEYFROM  ( SUBSTR ( RECORD ,2) ) ; 

43:        IF  LIST=,YI  THEN  DO; 

44:  PRINTER  =  •      '11  RECORD; 
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/*  :CREATE,FILE=TRAFFIC,LIST=XXXXX  */ 


45: 

CALL  PRINTX  (1J 

; 

46: 

end; 

47: 

end; 

48: 

DONE: 

49: 

PCNTR  =  CNTR  -  1; 

50: 

PRINTER  =  'NUMBER  OF 

RECORDS 

51: 

CALL  PRINTX  (3); 

52: 

CLOSE  FILE  <PERM); 

53: 

CLOSE  FILE  (BACKUP); 

54: 

CALL  EXIT  (PARM); 

55: 

END  CREATE; 

IN  FILE:   •  II  PCNTR; 
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LIST  (True  Mileage  file)  — 

Member  Name PFM 

Language PL/ 1 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  LIST  output 
TRUMILE  —  True  Mileage  file 

Instruction 1  -  3   "PFM" 

40  -  46  Beginning  key 
56  -  62   Ending  key 

LIST  provides  a  formatted  listing  of  True  Mileage  data  in  a  data  range 
specified  by  the  user  (by  means  of  the  DATA  parameter  on  the  command) . 
Subroutine  PRINTX1  is  used  for  the  listing,  allowing  the  use  of  all  HIS 
formatting  options  in  the  listing. 

The  PFM  program  listing  follows: 
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/*  :LIST,FILE=TRUMILE,OATA=XXXXX  */ 


l:  /*  :LIST,FILE=TRUMILE,DATA=XXXXX  */ 

2:  LIST:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 


3: 

4: 

5: 

6: 

7: 

8: 

9: 
10: 
11: 
12: 

13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 

22: 

23: 

24: 

25: 

26: 

27: 

28: 

29: 

30: 

31  : 

32: 

33: 


/*  INSTRUCTION  AND  PRINT  ROUTINE  */ 

DECLARE 

PARM  CHARUOO)  , 

INSTR  CHARI80)  EXT, 

STARTKEY  CHARC7)  DEF  INSTR  POS(40), 

ENDKEY  CHAR(7)  DEF  INSTR  POS(56>, 

#_HOGS  PIC'Z'  DEF  INSTR  POS(72>, 

HEADING(9)  CHAR(132)  EXT, 

PRINTER  CHAR( 132)  EXT, 

PRINTX  ENTRY  (PIC'Z1) ; 


/*  TRUE 
DECLARE 
I  TRM 
2 
2 
2 
2 
2 


MILEAGE  FILE  */ 


STATIC, 
DUM1  CHAR! 1) f 
RT_#  CHAR(4), 
MPOST  CHAR(3) , 
TRUE  DEC  FIXED 
DATE  DEC  FIXED 


[ 

: 
: 

: 


TPUMILE    FILE     INTERNAL 


VARIABLES    */ 


(7,3), 

(6,0) , 
RECORD 


KEYED    ENV    (INDEXED); 


/*    OUTPUT 
DECLARE 

CI     PIC  999999'  , 

YR     CHAR(2)     DEF    CI, 

MONTH    CHAR(2)     DEF    CI    P0S(3), 

DAY    CHAR(2)     DEF    CI     P0S(5), 

OUT    CHARl 132) , 

1       0    DEF    OUT, 

2       RT_#    CHAR (7), 

?       MPOST    CHAR(8) , 

2       TRUE    PIC,ZZZV.999BBI, 

2       DATE    CHAR(8); 


34:  /*»***  INITIALIZATION  *****/ 


35: 

36: 

37: 

38: 

39: 

40: 

41  : 

42: 

43: 

44: 

45: 

46: 

47: 

48: 

49: 

50: 


CALL  INIT  (PARM); 

#_HDGS  -  3; 

HEADING(l)  =  ' 

HEADING(2)  =  'PT_#   MPOST 

OPEN  FILE  (TRUMILE); 

ON  KEY  (TPUMILE)  BEGIN; 

PRINTER  =  '***  NO  TRUMILE 

CALL  PRINTX  (2)  ; 

GOTO  STOP; 

END; 
RFAD  FILE  (TRUMILE)  INTO  (TRM) 
ON  ENDFILE  (TRUMILE)  BEGIN; 

PRINTER  =  '   END  OF  FILE.1 J 

CALL  PRINTX  (3); 

GOTO  stop; 

end; 


TRUE 


1  • 


MILEAGE 


DATE' 


RECORD  FOR  KEY  •  I  I  STARTKEY; 


KEY  (STARTKEY); 
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/*  :LIST,FILE=TRUMILE,DATA=XXXXX  */ 


51:  /***  EXECUTION  LOOP  ***/ 


52 
53 
54 
55 
56 
57 
58 
59 
60 
61 
62 


LOOP: 

OUT  =  •  • ; 

O.RT_#  =  TRM.RT_#; 

O.MPOST  =  TRM.MPOST; 

O.TRUE  =  TRM.TRUE; 

CI  =  TPM.DATE; 

IF  TRM.DATE-=0  THEN  O.OATE  =  MONTH  I  I  •/■  II  OAY  I  I  •/•  II  YR ; 

PRINTER  =  OUT; 

CALL  PRINTX  (1); 

REAO    FIL4E    (TRUMILE)     INTO    (TRM); 

IF     TRM.RT_#| |TRM.MPOST<=ENDKEY    THEN    GOTO    LOOP; 


63:  STOP: 

64:     CLOSE  FILE  (TRUMILEI; 

65:     CALL  EXIT  (PARM) ; 

66:  END  LIST; 
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UPDATE  (True  Mileage  file)  —  UPDATE  consists  of  three  separate  programs: 

PDMD  for  deletion,  PDMI  for  insertion,  and  PDMR  for  revision  of  records. 

FUNCTION=DELETE: 

Member  Name PDMD 

Language PL  /I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 


[ 


PRINTER  —  UPDATE  output 

TRUMILE  —  True  Mileage  file  L 

any  name  —  Data  cards 

Instruction 1  -  4   "PDMD" 

24  -  31  Name  of  input  DD  statement  »■ 

r 
PDMD  reads  data  cards  containing  a  key  in  columns  1-7.   The  (_ 

record  corresponding  to  the  specified  key  is  deleted.   The 

data  cards  are  printed  as  they  are  read. 

The  PDMD  program  listing  follows: 


: 
: 
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/**:U°0ATE,     F  I  LE  =  TRUM I L E ,     FUNCT  I  ON  =  OELETE    DDNAMF=XXXXX    **/ 


1 

2 

3 

4 

5 

6 

7 

8 

9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 

21 

ZZ 

Z5 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 


/**:UPDA 
CANCEL:  P 
DECLARE 

INSTR 
#_HDG 
DDNAM 
PARM 
(HEAD 
PklNT 
CNSTD 
CNST 
NFWDT 
KFY1  C 
/**INIT** 

CALL 
/**  HDGS 
#_HDG 
HEAD! 
/**OPEN  F 
OPEN 
ON  FN 
OPEN 
ON  KE 
PR  I 
CAL 
GOT 
END 
/**MAIN  L 
READ_ 
REA 
PRINTE 

CALL 
DELETE 
GO  TO 
CLOSE 
CLOSE 
CLOSE 
CALL 
END  CANC 


TEf  FILE=TRUMILE»  FUNCT  inN=DELETE  DUNAME"  =  XXXXX  **/ 
ROC E DURE  (PARM)  OPTIONS  (MAIN); 

CHAR  (80)  EXT, 
S  PIC'Z'  DEF  INSTR  POS  ( 72) , 
E  CHAR(8)  DEF  INSTR  P0S(24), 
CHAR  (100), 

ING(9),  PRINTER)  CHAR(132)  EXT, 
X  ENTRY  (P  IC'Z'  ), 

0  CHAPI8)  STATIC  IN  I T (  • TPUM I L E ■  )  , 
FILE  RECORD  KEYED  FNV(  I  NDEXED  )  , 

FILE  RECORD, 

(PTR_NEWDT)  ; 


BASFD 


HAR( 16) 

/ 

INIT  (PARM); 

**/ 

S  =  2; 

NG(  1  )  =  CNSTDD|  | ' FILE  UPDATE  —  DELETION  OF  RECORDS' 

ILES**/ 

FILE    (NFWDT)     INPUT    RECORD    TITLE     (DDKAME); 

DFILE(NEWDT)     GO    TO    CLOSE; 

FILE(CNST)     UPDATE    DIRECT    T I TL E ( CNSTDD )  ; 

Y     (CNST)     BEGIN; 


NTER    =     '****RECORD 
L    PRINTX    (  1)  ; 
0    READ_NEWDT; 


DOES  NOT  EXIST  IN  FILE' 


(NEWDT  ) 


OOP**/ 

NEWDT: 

D  FILE 

R  =  • 

PRINTX     (2); 
FILE     (CNST) 
READ_NEWDT; 

FILE(CNST ) ; 
FILE(NEWDT)  ; 
EXIT     (PARM); 

el; 


SET(PTR. 
KEYl; 


NEWDT) 


KEY    (KEYl) 
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FUNCTION=INSERT : 

Member  Name PDMI 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  UPDATE  output 
TRUMILE   —  True  Mileage  file 
any  name  —  Data  cards 

Instruction 1  -  4   "PDMI" 

24  -  31  Name  of  input  DD  statement 


PDMI  reads  data  cards  containing  a  key  in  columns  1-7 ,  and 
a  true  mileage  in  columns  8-13.   The  true  mileage  is  converted 
to  decimal,  and  the  date  appended.   The  record  is  then  inserted 
into  the  file. 

The  PDMI  program  listing  follows : 


: 
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/***  MEMBER  NAME  PDMI  */ 

/***  MEMBER  MAME  PDMI  */ 

/**:UPDATE,FILE=TRUMILE,FUNCT IQN=WRITE ,  ODNAME=XXXXX  **/ 
INSERT:  PROC(PARM)  1PT  IONS< MA  IN )  ; 
DECLARE 
#_HOGS  PIC'Z'  DEE  INSTR  POS(72), 

INSTR  CHAR(BO)  EXT, 

DONAME  CHAR(S)  OEF  INSTR  POS<24), 

PARK  ChAR( 100) , 

(HEADING  (9), PRINTER)  CHARI132)  EXT, 

PRINTX  ENTRY(PIC»  Z'  )  , 

1  CARD  BASED1PTR ) , 
2  KEY  CHAR(7),  2  TRUE  P  IC ■ Z Z Z Ml  11 ■  , 

1  Tl  STATIC, 

DUM1  CHAH;i)  INITC  •),  2  KEY  CHAR(7), 
2  TRUE  DEC  FIXFD(7,3),  2  DTE  DEC  FIXED<7,0), 

DATER  CHAR(6),  DATES  PIC'ZZZZZZ1  DEF  DATEP, 

CNSTDD  CHAR(8)  STATIC  IN  I  T (  • TRUM  ILE •  ) , 

CNST  FILE  RECORD  KEYED  ENV( INDEXED ) , 

CD  FILE  RECORD; 
/**  PGM  INIT  **/ 

CALL  INIT(PARM); 

DATER=DATE; 

T1.DTE=DATES; 

#_HDGS=2; 

HEADING( 1 )='FILE  UPDATE  TO  TRUMILE  FOR  NEW  RECORDS'; 
/**  OPEN  FILES  **/ 

OPEN  FILE(CD)  INPUT  RECORD  T I TL F ( DON AME ) ; 

ON  ENDFILE(CD)  GOTO  CLOSE; 

OPEN    FILE(CNST)    UPDATE    DIRECT    T I TLE ( CNSTDD ) ; 

ON    KEY(CNST)     BEGIN; 

PRINTEK=»***EXISTING    RECORD,     ATTEMPT    TO     INSERT    NEW    ***• 

C4LL     PRINTX ( 1) ; 

GOTO    BRING_IN_DATA; 

END; 
/**    LOOP    **/ 
BRING_IN_DATA: 

RFAO    FILE(CD)     SET(PTR) ; 

PRINTERS  ' I ICARD.KEY; 

CALL  PRINTX<2); 

T1=CARD,  BY  NAME; 

WRITE    FILF(CNST)     FROM(Tl)     K EYFROM( T 1 .KE Y ) ; 

GOTO  BRING_IN_DATA; 

CLOSE: 

CLOSE  FILF(CNST); 

CLOSE  FILE(CD); 

CALL  EXIT(PARM); 

END  INSERT; 
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FUNCTION=REWRITE ; 

Member  Name PDMR 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  UPDATE  output 
TRUMILE  —  True  Mileage  file 
any  name  —  Data  cards 

Instruction 1  -  4   "PDMR" 

24  -  31  Name  of  input  DD  statement 

PDMR  reads  data  cards  (same  format  as  for  PDMI) ,  and  forms  a 
True  Mileage  record  by  converting  the  true  mileage  to  decimal 
and  appending  the  date.   The  resultant  record  is  then  entered 
into  the  file  with  a  REWRITE  statement.   An  optional  data 
card  format  may  be  used  for  adding  a  constant  value  (positive 
or  negative)  to  every  record  in  a  range  of  the  file.   The 
data  cards  have  the  format : 

±nn.nnn,srrr ,mmm    or 
±nn . nnn , srrr ,mmm ,mmm 

inn.nnn  is  the  constant  to  be  added.   Leading  zeroes  must  be 
supplied  if  the  value  is  less  than  10,  and  the  decimal  point 
is  punched.   The  sign  (+  or  -)  must  be  in  column  1.   srrr  is 
the  route  system  ("I,"  "P,"  or  "S")  followed  by  the  route 
number.   Leading  zeroes  must  be  coded  in  the  route  number  to 
fill  three  digits,   mmm  is  a  reference  post.   If  the  first  format 
is  used,  the  program  begins  with  this  reference  post  and  con- 
tinues to  the  end  of  the  route.   If  the  second  format  is  used 
(note  that  the  second  reference  post  must  be  at  least  as  large 
as  the  first) ,  the  program  begins  at  the  first  reference  post 
and  continues  through  the  second. 

The  PDMR  program  listing  follows: 
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/**M£MBER  NAME  PQMR**/ 


/♦♦MEMBER  NAME  PDM 
/♦♦:UPOATE,  FILE=T 
REVISE:   PROCEDURE- 
DECLARE 

INSTR  CHAR(RO)E 
#_HDGS  PIC'Z'  D 
DDNAMfc  CHAR (8) 
( HEADING(9 ),PRI 
PRINTX  ENTRY(PI 
CNSTDD  CHAR(8) 
CNST  FILE  RECUR 
CD  FILE  RECORD, 
NUMBER  PIC'SZZV 
C  CHAR(30)  BASE 
1  CARD  BASED(PT 
2  KEY  CHAR( 7) , 
1  Ti  STATIC, 
2  OU^l  CHAR< 1) 
2  TRUE'  DEC  FIX 
DATER  CHAR(6), 
CALL  I  NIT  (PARM 
DATER  =  DATE; 
*_HDGS=2; 
NEAOINGU)=  'HI 
/♦♦FILES  OPEN**/ 

OPEN  FILE* CD)  I 

ON  ENDFILE(CD) 

OPEN  FILE  (CNST) 

ON  KEY  (CNST)  B 

PRINTER  =  •** 

CALL  PRINTX  (1) 

GOTO  LUUP; 

END; 

/♦♦MAIN  LOOP**/ 
LOOP: 

READ  FILf(CD)  S 

POINTER  =  (5) •  ■ 

CALL  PRINTX  (2); 

/♦  TEST  FOR  MILEA 

IF     SUBSTR(CARD. 

READ    FILE(CNST) 

Tl.TRUF=CARO.TR 

Tl .DTE=DATES; 

REWRITE  FILE(CN 

GOTO  LOOP; 

CH:    /♦  TRUE  MILEA 

IF  SUBSTR(C,4,1 

(SUBSTR(C, 17,1 ) 

PRINTER=  •♦♦ER 

•  4, 
CALL  PRINTX(2 
GOTO  LOOP; 
END; 
IF  SUBSTR(C,9,1) 

DO; 
PRINTER=  •♦♦ER 

'  I, 
CALL  PRINTX(2 


R**/ 

RUMILEf FUNCT ION=REW 

(PARM)     OPTIONS     (MAI 

XT,     PARM    CHARt 100) , 
EF     INSTR    P0S(72), 
OFF     INSTR     POS( 24) , 
NTER)     CHAR(132)     EXT 
C'Z  '  )  , 

STATIC    INIT( ' TKUM IL 
D    KFYED    ENV(  INDEXED 

.ZZZ1     BASEO(PTR), 
D(PTR  ), 
R>  ,     • 
2    TRUE    PIC'ZZZVZZZ 

IN  IT ( •  •  )  ,  2  KEY  C 

£0(7,3),  2  DTE  DEC 
DATES  PIC'ZZZZZZ'  D 

); 


RITE,  DDNAME=XXXXX**/ 
N)  ; 


E«  )  , 
)t 


HAR(7)  , 

F  I  X  E  D  (  7 ,  0 )  , 

EF  DATER; 


S  TRM  FILE  REVISION' 


NPUT  RFCOPD  TITLE  ( 
GOTO  FINISH; 

UPDATE  TITLE  (CNST 
FGIN; 

^RECORD  DOES  NOT  FX 


DDNAME ) ; 

DO)  ; 

1ST  IN  FILE**1; 


ET  (PTR); 

II  c ; 

GE  ALTERING  RECORD 
KEY,  1,  1  )  =  •♦•  |  SUBSTP 
INTO(Tl)  KEY(CA*D. 

ue; 

ST  )  FROM(Tl)  ; 

GF    ALTERING    RECORD 
)-.=  •.•!  SUBSTR(C,8,  1 
-.=  ••&     SUBSTR(C,17 
ROR     IN    CODING    OF     , 
8,     13,     17,     CHANGES 

); 


*/ 

(CARD. KEY, 1  ,  1  )^  •-  '     THEN 
KEY)  ; 


GOTO    CH; 


EDIT    ♦  / 

)-.  =  •,'  I  SUBSTRCC13,  1  )-.= 

,!)-.=  •,•)     THEN    DO; 

.  OR  BLANKS  IN  CARD  LOL 

IN  TRUE  MILEAGE  NUT  MAD 


UMNS  ' 
F«  ; 


-.=  •!•  &SUBSTR(C,9,l)-.=  ,P'dSUBSTR(C,^,  1)-='S'  THEN 


ROR  IN  SYSTEM  CODE, 
P,  OR  S   CHANGES  IN 

); 


CARD  COLUVN  9,  MUST  BE 
TRUF  MILEAGE  NOT  MADT' 


-193- 


/**MEMBER  NAME  PDMR**/ 


59 
60 
61 
62 
63 
64 
65 
66 
67 
68 
69 
70 
71 
72 
73 
74 
75 
76 
77 


GOTO  LOOP; 
END; 
READ  FILE  (CNST)  INTO  (Tl) 
COMP:   /*  TRUE  MILEAGE  CHANGE 
T1.0TF=DATES; 
T1.TRUE=T1.TRUE«-NUMBER; 
REWRITE  FILE(CNST)  FROM(Tl); 
PRINTER  =  ( 10) »  •  ] I  Ti.KEY  | | 
CALL  PRINTX  (1); 
READ  FILE(CNST)  INTO(Tl) ; 
IF  SUBSTR<T1.KEY,2,3)-.=  SUBSTR<C,10,3) 
IF  SUBSTR(T1.KEY,5,3)>SUBSTR(C,18,3) 

GOTO  LOOP; 
ELSE  GOTO  COMP; 
FINISH: 

CLOSE  FILE(CNST); 
CLOSE  FILE(CD) ; 
CALL  EXIT  (PARM); 
END  REVISE; 


KEY  { SUBSTR(C,9,4) I  I SU8STR( C , 14  ,  3 )  )   ; 
ROUTINE  */ 


Tl.TRUE 


THEN  GOTO  LOOP; 
&  SUBSTRiC,  18,3) -»=* 


THEN 
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COPY  (True  Mileage  file)  — 

Member  Name PBM 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER   —  COPY  output 
TRUMILE  —  True  Mileage  file 
SAVETRM  —  Backup  copy  (output) 

Instruction 1  -  3   "PBM" 

COPY  prepares  a  backup  copy  of  the  True  Mileage  file.   The  backup  copy  is  a 
sequential  version  of  the  file,  with  identical  record  length  (16).   A  dummy 
record  containing  the  date  is  first  written.   This  record  is  followed  by  the 
True  Mileage  records.   The  records  are  counted  during  the  COPY  operation, 
and  the  number  of  records  in  the  file  printed  after  the  last  record  is 
rewritten. 

The  PBM  program  listing  follows: 
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/*     :COPY,FILE=TRUMILE    */ 

l:  /*    :COPY,FILE=TRUMll_E    */ 

2:  COPY:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 

3:  /*  INSTRUCTION  */ 

4:  DECLARE 

5:     INSTR  CHAR(80)  EXT, 

6:     #_HDGS  PIC'Z'  OEF  INSTk  PQS(72); 

7:  /*  PRINT  ROUTINE  */ 

8:  DECLARE 

9:     PARM  CHAR{ 100) , 
10:    (HEADING(9) , PRINTER )  CHAR(132)  EXT, 
11 :     PRINTX  ENTRY  (PIC'Z* ) ; 

12:  /*  FILES  */ 

13:  DECLARE 

14:     RECORD  CHAR(16)  8ASFD  (PTR), 

15:     8ACKDD  CHAR(8)  STATIC  INIT  {'SAVETRM'), 

16:     PERMDD  CHAR(8)  STATIC  INIT  CTRUMILEMt 

17:     PERM  FILE  RECORD  KEYED  FNV  (INDEXED), 

18:     BACKUP  FILE  RECORD; 

19:  /*  OTHER  VARIABLES  */ 

20:  DFCLARE 

21 :     UD  CHAR (6) , 

22:     CNTR  BIN  FIXED  ( 31) , 

23:     PCNTR  PIC  ZZZZZ9'  ; 

24:  /*****  INITIALIZATION  *****/ 

25:     CALL  INIT  (PARM) ; 

2fc:     /*  SET  OP  HEADINGS  */ 

27:     #_HDGS  =  ?; 

28:     HEADING(I)  =  PERMDD  I  I  'FILE  COPY  ROUTINE'; 

29:     /*  INIT  FILES  */ 

30:     OPFN  FILE  (PERM)  INPUT  TITLE  (PERMDD); 
31:     OPEN  FILE  (BACKUP)  OUTPUT  TITLE  (BACKDD); 
32:     ON  ENDFILF  (PERM)  GOTO  DONE; 

33:     /*  RECORD  DATE  */ 

34:     UD  =  DATE; 

35:     PTR  =  ADOR (HEADINGI9)  ); 

36:     RECORD  =  SUBSTR ( UD , 3, 2 )  I  I  '/'  || 

37:  SUBSTP (UD,5,2)  II  '/'  I  I  SUBS TR ( UD, 1 , 2 )  ; 

38:     WRITE  FILE  (BACKUP)  FROM  (RECORD); 


39:  /*****  MAIN  EXECUTION  LOOP  *****/ 

40:  DO  CN7R=1  TO  999999; 

41:         READ  FILE  (PERM)  SET  (PTR); 

42:         WRITE  FILE  (BACKUP)  FROM  (RECORD); 

43:        END; 
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/*  :COPY,FILE=TRUMILE  */ 


44:  DONE: 

45:     PCNTR  =  CNTR  -  1; 

46:     PRINTER  -  'NUMBER  OF  RECORDS  IN  FILE:   '  II  PCNTR; 

47:     CALL  PRINTX  (3); 

48:     CLOSE  FILE  (PERM); 

49:     CLOSE  FILE  (BACKUP); 

50:     CALL  EXIT  (PARM) ; 

51 :  END  COPY; 
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CREATE  (True  Mileage  file)  — 

Member  Name PAM 

Language PL/I 

Subroutines  SYSPRINT  —  IBM  messages 

PRINTER  —  CREATE  output 

TRUMILE  —  True  Mileage  file  (output) 

SAVETRM  —  Backup  copy 

Instruction 1  -  3   "PAM" 

CREATE  restores  the  True  Mileage  file  from  a  backup  copy  saved  via  program 
COPY.   The  first  record  in  the  file  is  a  dummy  record,  containing  the  date 
on  which  the  file  was  copied.   This  date  is  printed  prior  to  performing  the 
create  operation.   After  printing  the  date,  the  records  are  read  from  the 
backup  copy  and  written  into  the  True  Mileage  file,  destroying  the  previous 
file.   As  with  COPY,  the  records  are  counted  as  they  are  written.   The  count 
is  printed  after  the  create  operation  is  complete. 
The  PAM  program  listing  follows: 
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/*  :CREATE,FILE=TRUMILE  */ 

l:  /*  :CREATE,FILE=TRUMILE  */ 

2:  CREATE:   PROCEDURE  (PARM)  OPTIONS  (MAIN); 

3:  /*  INSTRUCTION  */ 

4:  DECLARE 

5:  INSTR  CHAR(80)  EXT, 

6:  #_HDGS  PIC'Z'  DEF  INSTR  POS<72); 

7:  /*  PRINT  ROUTINE  */ 

8:  DECLARE 

9:  PAPM    CHAM  100)  , 

10:  (HFADINGI9)  .PRINTER  )     CHARI132)     EXT, 

11 :  PRINTX    ENTRY     (PIC'Z'I; 

12:  /*    FILES    */ 

13:  DECLARE 

14:  RFCORD    CHAP(16)     BASED    (PTR), 

15:  BACKDD    CHAR(8)    STATIC     INIT     (•SAVETRMM, 

16:  PEPMDD    CHAR(8)     STATIC     INIT    (•TRUMILEM, 

17:  PFPM    FILE    RECORD    KEYED    ENV     (INDEXED), 

18:  BACKUP    FILE    RECORD; 

19:  /*    OTHER    VARIABLES    */ 

20:  DECLARE 

21 :  CNTR    BIN    FIXFD    (31), 

22:  PCNTR    PICZZZZZ9'; 

23:  /*****     INITIALIZATION    #****/ 

24:  CALL     INIT     (PARM); 

25:  f*     SET  UP  HEADINGS  */ 

26:  &_HDGS  =  2; 

27:  HEADING! 1 1  =  PERMDD  ||  'FILE  CREATION  ROUTINE1; 

28:  /*  IN  IT  FILES  */ 

29:  OPEN  FILE  (BACKUP)  INPUT  TITLE  (BACKDD); 

30:  OPEN  FILE  (PERM)  OUTPUT  TITLE  (PERMDD); 

31:  ON  ENDFILE  (BACKUP)  GOTO  DONF; 

32:  /*  PRINT  DATE  */ 

33:  READ  FILE  (BACKUP)  SET  (PTR); 

34:  PRINTER  =  •    DATE  OF  BACKUP  FILE  IS  *  ft  RECORD; 

35:  CALL  PRINTX  (1); 

36:  PRINTER  =  ■  ■  ; 

37:  CALL  PRINTX  (  1)  ; 

38:  /*****  MAIN  EXECUTION  LOOP  *****/ 

39:  DO  CNTR=1  TO  999999; 

40:  READ  FILE  (BACKUP)  SET  (PTR); 

41:  WRITE  FILE  (PERM)  FROM  (RECORD)  KEYFROM  ( SUBSTR ( RECORD  ,2 1 > ; 

42:  END; 

43:  DONE: 
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/*     :CREATE,FILE=TRUMILE    */ 

XV:  P*mE=R   ="•—   OE    RECORDS    IN    FILE:       ■     II    PCNTK, 

46;  CALL    PRINTX     (3); 

47r  CLOSE    FILE     (PERM); 

48:  CLOSE    FILE    (BACKUP); 

49:  CALL    EXIT     (PARM); 

50:  END   CREATE; 
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CREATE-TRAFSUB  — 

Member  Name CRT 

Language PL/ 1 

Subroutines none 

Files  SYSPRINT  —  Printer  output 

TRAFFIC   —  Traffic  file 

TRUMILE  —  True  Mileage  file 

TRAFSUB  —  Traffic  Summary  file  (output) 

Instruction 1  -  3  "CRT" 

CREATE-TRAFSUB  creates  the  Traffic  Summary  file  utilizing  the  Traffic  and  True 
Mileage  files.   Vehicle  miles  and  section  lengths  are  included  in  the  file 
for  three  years  (from  the  first  three  data  year  positions  of  the  Traffic  file) . 
The  section  length  is  obtained  through  use  of  the  True  Mileage  file.   For  each 
section,  the  program  must  obtain  the  ADT's  from  the  Traffic  file,  and  weight 
these  over  the  section  (each  section  may  have  any  number  of  minor  section 
breaks) .   The  program  checks  for  a  valid  sequence  of  remark  codes  in  the 
Traffic  file.   For  example,  an  "M"  record  (municipal  minor  section  break) 
cannot  follow  a  "W"  record  (rural  major  section  break).   If  such  a  sequence, 
or  any  other  invalid  sequence,  is  detected,  an  error  message  is  printed.   When 
a  record  contains  no  data  for  one  or  more  of  the  years ,  no  vehicle  miles  will 
be  stored  in  the  file  for  those  years  in  the  section  the  record  is  located. 
Hence,  major  section  break  records  beginning  and  ending  a  section  may  contain 
data  pertaining  to  the  sections  preceding  and  following  the  section,  but  a 
minor  break  record  within  the  section  containing  no  data  will  cause  that  data 
to  be  ignored  in  the  section.   On  rural  records,  counts  are  taken  each  year. 
Hence,  most  records  contain  data  for  all  three  years.   However,  when  a  new 
road  is  built,  only  the  most  recent  year  will  be  coded;  the  following  year, 
only  two  years  will  be  coded.   It  is  not  valid,  however,  to  have  any  other 
combination  of  uncoded  years  on  rural  records  (such  as  only  the  second  year 
coded,  or  no  years  at  all  coded).   The  presence  of  such  a  record  will  cause 
a  message  to  be  generated.   Any  combination  of  blank  data  may  be  present  in 
municipal  sections;  counts  are  not  necessarily  taken  every  year.   Hence,  no 
error  messages  are  generated  pertaining  to  blank  data  in  municipal  sections. 
No  data  is  coded  in  non-existent  sections.   If  any  is  present,  it  is  not  used. 
The  CRT  program  listing  follows: 
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/*  :CREATF_TRAFSUB  */ 

l:  /*  :CREATE_TRAFSUB  */ 

2:  CREATE:   PROCEOURE  OPTIONS  (MAIN); 


3 

4 

5 

6 

7 

R 

9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 


28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 

39 
40 
41 
42 
43 
44 
45 
46 
47 
48 
49 
50 
51 
52 
53 


/*  TRAFFIC  FILE  */ 
DECLARE 

1   TRF  BASED  <PTR_TRF), 
2   DELETE  CHAR( 1), 
2   KEY  CHAR(13) , 

2  (RT_#,MPOST>  DEC  FIXED  (3,0), 
2   OFFSET  DEC  FIXED  (5,3)t 
2  (  ACT.EST, REMARK)  CHAR(l), 
2   D(3), 

3   YR  DEC  FIXED  (3,0) , 
3   ADT  DEC  FIXED  (5,0), 
3   PER13)  DEC  FIXED  (3,3), 
TRFB  CHAR(80)  BASED  (PTR_TRF), 
HOLD_TRF  CHAR(33), 

1   SAVE  BASED  (PTR_SAVE)  LIKE  TRF, 
SAVE.B  CHAR(80)  STATIC, 
TRAFFIC  FILE  INT  RECORD  KEYED  ENV  (INDEXED); 


20:  /*  TRUE  MILEAGE  FILE  */ 

21:  DECLARE 

22:     1   TRM  BASED  (PTR_TRM), 

23:         2   KEY  CHAR(5), 

24:         2   MPOST  PIC*999«, 

25:         2   TRUE  DEC  FIXED  (7,3), 

26:     MLGE(0:999)  DEC  FIXED  (7,3)  STATIC, 

27:     TRUMILE  FILE  INT  RECORD  KEYED  ENV  (INDEXED  GENKEY) ; 


/*  TRAFSUB  FILE  */ 
DECLARE 

1   SUB  STATIC, 

2   DUMMY1  CHAR(l)  INIT  (•  •), 

2   KEY  CHAR(13) , 

2   REMARK  CHAR( 1) , 

2   LENGTH  DEC  FIXED  (7,3), 

2   D(3), 

3       VM(4)    DEC    FIXED    ( 11,3), 
2       DUMMY2    CHAR(5)     INIT     (•     •), 
TRAFSUB    FILE     INT    RECORD    OUTPUT    KEYED    ENV    (INDEXED); 

/*    OTHER    VARIABLES    */ 
DECLARE 

(C1,C2)    CHAR(l), 

(ADT (3, 4) ,VM(3,4) ,T0T1_VM( 3 , 4 ) , T0T2.VM ( 3,4) ) 

DEC    FIXED    (11,3)    STATIC, 
(ST0T1_VM(3,4),ST0T2_VM(3,4) )     DEC    FIXED    (11,3)    STATIC, 
(TUT1_LENGTH,T0T2_LENGTH)    DEC    FIXED    (9,3), 
( ST0T1_LENGTH,ST0T2_LENGTH>     DEC    FIXED    (9,3), 
(XI, X2)     DEC    FIXED    (7,3), 
(FLAGK  3),FLAG2(3))     CHAR(l)     STATIC, 

LENGTH  DEC  FIXED  (5,3)  STATIC, 

SAVE.SYSTEM  CHAR(l)  STATIC  INIT  (•  •), 

YR_RCD  CHAR(96), 

ERROR  DEC  FIXED  (3,0), 

ERR  FLAG  CHAR(l)  STATIC  INIT  (•  •); 
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/*    :CREATE_TRAFSUB    */ 


54:  /*****    INITIALIZATION    *****/ 

55:  OPEN 

56:  FILE  (TRAFFIC), 

57:  FILE  (TRUMILE), 

53:  FILE  (TRAFSUB); 

59:  ON  ENOFILE  (TRAFFIC)  TRF.RT_#  =  0; 

60:  ON  ENDPILE  (TRUMILE)  TRM.KEY  =  •  •; 

61:  ON  KEY  (TRAFSUB)  BEGIN; 

62:  PUT  FILE  (SYSPRINT)  SKIP  EDIT  («***KEY  ERR:   «»SUB.KEY)  (A); 

63:  GOTO  ENDUP; 

64:  END;                                                    f 

65:  /*  READ  FIRST  TRAFFIC  RECORD  */ 

66:  READ  FILE  (TRAFFIC)  SET  (PTR.TRF); 

67:  YR_RCD  =  TRFB; 

68:  WRITE  FILE  (TRAFSUB)  FROM  (YR.RCD)  KEYFROM  ( SUBSTR ( YR_RCD ,2 ) ) ; 

69:  /*  READ  FIRST  INTERSTATE  RECORD  */ 

70:  READ  FILE  (TRAFFIC)  SET  (PTR_TRF); 

71:  PTR_SAVE  =  ADDR( SAVE_B) ; 

72:  /*  INIT  VAR  */ 


73 
74 
75 

76 
77 
78 
79 

80 
81 
82 
83 
84 
85 
86 
87 


INIT.VAR: 
VM  =  o; 

T0T1_VM,  T0T2_VM  =  0; 
T0T1.LENGTH,  T0T2_LENGTH  =  0; 
IF  SUBSTR(TRF.KEY,1,1)-.=  SAVE_SYSTEM  THEN  DO; 

ST0T1_VM,  ST0T2_VM  =  0; 

ST0T1_LENGTH,  ST0T2_LENGTH  =  0; 

END; 
READ  FILE  (TRUMILE)  SET  (PTR_TRM)  KEY  ( SUBSTR( TRF . KE Y, 1 ,4 ) ) ; 
MLGE  =  0; 
DO  WHILE  (SUBSTR(TRM.KEY,2,4)=SUBSTR(TRF.KEY, 1,4) ) ; 

MLGE(TRM.MPOST)  =  TRM.TRUE; 

READ  FILE  (TRUMILE)  SET  (PTR.TRM); 

END; 
X2  =  o; 


88:  /*****  EXECUTION  LOOP  *****/ 

89:  LOOP: 

90:     /*  SAVE  PREVIOUS  VALUES  */ 

91:     SAVE.SYSTEM  =  SUBSTR( TRF.KEY , 1, 1 ) ; 

92:     SAVE_B  =  TRFB; 

93:     XI  =  X2; 

94:  LOOPE: 

95:     /*  GET  NEXT  TRAFFIC  RECORD  */ 

96:     READ  FILE  (TRAFFIC)  SET  (PTR_TRF); 

97:     /*  CHECK  FOR  NEW  ROUTE  */ 
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/*    :CREATE_TRAFSUB    */ 

98:     IF  TRF.RT_#-=SAVE.RT_#  THEN  DO; 

99:  SUB. KEY  =  SAVE. KEY; 

100:  SUB. REMARK  =  fE» ; 

101:  SUB. LENGTH  =  0; 

l103:-  WRm    FRE    (TRAFSUB)    FROM    (SUB)    KEYFROM    (SUB. KEY); 

104:  SUBSTR(SUB.KEY,5)    =    '999RURAL'; 

105:  SUB. LENGTH   =    T0T2.LENGTH; 

106:  DO    1=1    TO    3; 

107:  SUB. Dili. VM<*»    =    T0T2_VM< I ,* ) ♦ 

JoT:  WRITE°FILE    (TRAFSUB)    FROM    (SUB)    KEYFROM     (SUB. KEY); 

110:  ST0T1_VM    =    ST0T1_VM    +    T0T1.VM; 

111:  ST0T2.VM   =    ST0T2.VM    +   T0T2_VM;  cwrTH. 

112:  ST0T1.LENGTH    =    ST0T1.LENGTH    ♦    TOT -LENGTH, 

113:  ST0T2_LENGTH    =    ST0T2.LENGTH    ♦    T0T2 -LENGTH, 

U4:  IF    SUBSTR(TRF.KEY,1,1)-=SAVE_SYSTEM    THEN    DO, 

U5:  SUBSTR(SUB.KEY,2)    =     '999RURAL'; 

U6:  SUB. LENGTH    =    ST0T2.LENGTH  ; 

117:  DO    1=1    TO    3; 

118:  SUB.D(I).VM(*)    =    ST0T2.VM  ( I  ,  *)  *. 

Izoi  WRITE°FILE  (TRAFSUB)  FROM  (SUB)  KEYFROM  (SUB.KEY) 

121:  END; 

122:  IF  TRF.RT_#-=0  THEN  GOTO  INIT.VAR; 

123:  GOTO  ENDUP; 

124:  END; 


125: 

/* 

VALID  REMARK  SEQUENCES 

• 
• 

126: 

WW 

OW   TW 

NW 

RW 

MW 

SW 

LW   CW 

127: 

WO 

00   TO 

NO 

RO 

MO 

SO 

LO   CO 

128: 

WT 

OT   TT 

NT 

RT 

MT 

ST 

LT   CT 

129: 

WN 

ON   TN 

NN 

RN 

MN 

SN 

LN   CN 

130: 

WR 

OR 

RR 

131: 

TM 

MM 

132: 

WS 

OS   TS 

NS 

CS 

133: 

WL 

OL   TL 

NL 

CL 

134: 

WC 

OC   TC 

NC 

sc 

LC   CC 

135: 

136: 

CI 

=  SAVE 

.REMARK 

• 
» 

137: 

C2 

=  TRF. 

remark; 

138: 

IF 

C2=,W« 

1  C2=#l 

3«  1 

C2=« 

T«  1 

C2  = 

•N»  THE 

139: 

IF 

C2=,R* 

L     (Cl= 

•W»  1 

Cl  = 

•0« 

1  CI 

=«RI )  T 

140: 

IF 

C2=,M» 

G  (Ci  = 

•T«  1 

Ci  = 

•M«  ) 

THEN  GOTO 

141  : 

IF 

(C2='S 

•  I  C2= 

•L«  1 

C2  = 

•C1  ) 

a 

142: 

(Cl=*W 

•  I  Cl  = 

•0«  1 

Cl  = 

•T« 

1  CI 

=  «N«  1 

143: 

THEN  GO    VALI 

144: 

IF 

C2='C« 

I    (Cl  = 

•S»  1 

Cl  = 

»L«  ) 

THEN  GOTO 

145: 

ERROR    I 

; 

146: 

GOTO  ERROR_MSG; 

goto  valid; 
then  goto  valid; 

VALID; 

C1=,C») 

VALID; 


147:  VALID: 

148:     /*  SEQUENCES  THAT  DO  NOT  REQUIRE  PROCESSING: 

149:  SW   LW   CW 

150:  ST   LT   CT 
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/*  :CREATE_TRAFSUB  */ 

151:  SO   LO   CO 

152:  SN   LN   CN 

153:  */ 

154:  IF  (Cl^'S1  I  Cl=«Lf  I  C1=«C»)  L 

155:        (C2=«W«  |  C2='0»  I  C2=«T»  I  C2=»N») 

156:        THEN  DO; 

157:         X2  =  MLGE(TRF.MPOST)  ♦  TRF. OFFSET; 

158:        GOTO  LOOP; 

159:        END; 

160:  /*  SEQUENCES  REQUIRING  DUMMY  RECORDS: 


161 
162 
163 
164 
165 
166 
167 
168 
169 
170 
171 
172 
173 
174 
175 
176 
177 


WS   TS   CS   NS   OS 

WL   TL   CL   NL   OL 

WC   TC   CC   NC   OC   SC   LC 

*/ 
IF  C2=«S»  I  C2=,L»  I  C2=«C«  THEN  DO; 
SUB. LENGTH  =  0; 
SUB.D  =  0; 
IF  C1-.=  «C«  £  Cl^'S'  I    Cl-^'L1  THEN  00; 

SUB. KEY  =  SAVE. KEY; 

SUB. REMARK  =  «D»; 

WRITE  FILE  (TRAFSUB)  FROM  (SUBl  KEYFROM  (SUB. KEY); 

END; 
SUB. KEY  =  TRF. KEY; 
SUB. REMARK  =  C2 ; 

WRITE    FILE    (TRAFSUB)     FROM     (SUB)     KEYFROM    (SUB. KEY); 
GOTO    LOOP; 
END; 


178:  /*    NON-EXISTANT    SECTIONS    ( NN, NW, NT ,N0)    */ 

179:  IF  Cl=«N'  THEN  DO; 

180:         SUB. KEY  =  SAVE. KEY; 

181:         SUB. REMARK  =  'N' ; 

182:         X2  =  MLGE(TRF.MPOST)  ♦  TRF. OFFSET; 

183:         SUB. LENGTH  =  X2  -  XI; 

184:         SUB.D  =  0; 

185:         WRITE  FILE  (TRAFSUB)  FROM  (SUB)  KEYFROM  (SUB. KEY); 

186:        TQT2._LENGTH  =  T0T2.LENGTH  ♦  SUB. LENGTH; 

187:         GOTO  LOOP; 

188:         END; 

189:  /*  ALL  REMAINING  SEQUENCES  REQUIRE  COMPUTATIONS  */ 

190:  /*  INIT  VAR  IF  NEW  SECTION  */ 

191:  IF  C1=«W»  I  Cl=,T»  I  Cl=*0»  THEN  DO; 

192:         SUB. REMARK  =  CI; 

193:         SUB. LENGTH  =  0; 

194:         SUB. KEY  =  SAVE. KEY; 

195:         VM  =  0; 

196:        FLAG2  =  'X»; 

197:         END; 

198:  /*  CALCULATE  SECTION  LENGTH  */ 

199:  X2  =  MLGE(TRF.MPOST)  ♦  TRF. OFFSET; 

200:  LENGTH  =  X2  -  XI; 

201:  SUB. LENGTH  =  SUB. LENGTH  ♦  (X2-X1); 
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/*  :CREATE_TRAFSUB  */ 

/*  IF  JCT,  CARRY  ORIGINAL  DATA  THROUGH  */ 
IF  LENGTH<=.Q1  £  (C1=»R«  I  C1='M«  I  C2='R«  I  C2='MM 
THEN  DO; 

HOLD.TRF  =  SUBSTR( TRFB, 24,33) ; 

SUBSTR(TRFB,24, 33)  =  SUBSTR ( SAVE.Bt 24, 33) ; 

END; 

/*  CHECK  FOR  BLANK  DATA  */ 
FLAG1  =  •X*  ; 
DO  1=1  TO  3; 

IF    TRF.D(I).YR=0     I     SAVE .D(  I )  .YR=0    THEN    FLAG1U)    =     'B«; 

END; 
213:  /*    VALID    BLANK/NON-BLANK    COMBINATIONS    ON    RURAL    SECTIONS: 


202: 

203: 

204: 

20*: 

206: 

207: 

208: 

209: 

210: 

211: 

212: 

214 
215 
216 
217 
218 
219 
220 
221 
222 
223 
224 


B   B   X   (NEW  ROAD) 

B   X   X   (NEW  ROAD— USED  TWO  YEARS) 

XXX   (ALL  YEARS  CODED) 

*/ 
IF  C1=,T»  |  C1=«M»  THEN  GOTO  ALL.RIGHT; 
IF  FLAG1(1)=«X«  €  FLAG1(2)=,X»  I    FLAG1(3)=«X« 
FLAG1(1)=,B»  £  FLAG1(2)=,X«  €  FLAG1(3)=»X» 
FLAG1(1)=»B«  £  FLAG1(2)=,B'  £  FLAG1(3)=«X» 
THEN  GOTO  ALL_RIGHT; 
ERROR  =  2; 
GOTO  ERROR_MSG; 


225:  ALL_RIGHT: 

226:  DO  1=1  TO  3; 

227:        IF  FLAG1(I)  =  ,B«  THEN  FLAG2( I  )  =  'B1; 

228:        END; 

229:  /*  CALCULATE  ADT»S  */ 

230:  ADT(*,1)  =  (SAVE.ADT  ♦  TRF.ADT)  /  2\ 

231:  DO  1=1  TO  3; 

232:        ADT(*,I+1)  =  ( S AVE. ADT*SAVE.PER ( *, I )  ♦  TRF. AOT*TRF .PER( *, I ) )  /  2 

233:        END; 

234:  /*    CALCULATE    VEHICLE    MILES    */ 

235:  VM    =    VM    ♦    LENGTH*ADT; 

236:  /*    RESTOR    DATA    IF    AT    JCT    */ 

237:  IF    LENGTH<=.01    L    (C1=,R»     I    Cl^M*     I    C2  =  »R«     I     C2='MM 

238:  THEN    SUBSTR(TRFB, 24, 33)    =    HOLD.TRF; 

239:  /*    IF    NOT    SECTN    BREAK,    RETURN   TO    LOOP    */ 

240:  IF    C2=»R'     I     C2=*M«     THEN    GOTO    LOOP; 

241:  /*    ZERO    OUT    VM»S     IN    SECTIONS    WITH    BLANK    FIELDS    */ 

242:  DO    1=1    TO    3; 

243:  IF    FLAG2(1)=,B«     THEN    VM(I,*)    =    0; 

244:  END; 

245:  /*  ZERO  OUT  COMM ,  PICKUPS,  OUT  OF  STATE  IF  MUNICIPAL  */ 

246:  IF  SUB. REMARKET'  THEN  DO  I  =  2  TO  4; 
247:        VM(*,I)  =  0; 
248:        END; 
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/*  :CRFATE_TRAFSUB  */ 


249 
250 
251 
2  52 
253 
2  54 
255 
256 
257 
258 
259 
260 
261 
262 
263 

264 
265 
266 
267 
268 
269 
270 
271 
272 
273 
2  74 
275 
276 
277 
278 
279 


/*  WRITE  TO  OUTPUT  FILE  */ 
DO  1=1  TO  3; 

SUB.DI I ) .VM(*)  =  VM( I,*) ; 
END; 
WRITE  FILE  (TRAFSUB)  FROM  (SUB)  KEYFROM  (SUB. KEY); 
IF  SUB. REMARKET' 
THEN  DO; 

T0T1_VM  =  TOTl^VM  +  VM; 

T0T1_LENGTH  =  T0T1_LENGTH  +  SUB. LENGTH; 
END; 
ELSE  DO; 

T0T2.VM  =  T0T2_VM  ♦  VM ; 

T0T2_LENGTH  =  T0T2.LENGTH  +  SUB. LENGTH; 
END; 
GOTO  LOOP; 

ERROR_MSG: 

IF  ERR_FLAG='  ■  THEN  DO? 

PUT  FILE  (SYSPRINT)  SKIP  EDIT 

(•     CREATE_TRAFSUB  DIAGNOSTICS')  (A); 

ERR^FLAG    =    •X'  ; 

END; 
IF    ERROR    =    1 

THEN    PUT    FILE     (SYSPRINT)     SKIP    EDIT 

(•REMARK    SEQUENCE    ERROR    (',C1,C2.')    AT    KEYS    », SAVE. KEY,*    AND 

TRF.KEY)     (A); 
IF    ERR0R=2 

THEN  PUT  FILE  (SYSPRINT)  SKIP  EDIT 

(•INVALID  BLANK  DATA  ON  RURAL  RECORD  •, SAVE. KEY,1  OR  •, 

TRF.KEY)  (A); 
IF  ERROR=l  THEN  GOTO  LOOPE; 
GOTO  LOOP; 


280:  ENDUP: 

281:     PUT  FILE  (SYSPRINT)  SKIP  (3)  EDIT 

282:        ('TRAFSUB  FILE  CREATED')  (A); 

283:     CLOSE 

284:        FILE  (TRAFFIC), 

285:        FILE  (TRUMILE), 

286:        FILE  (TRAFSUB); 

287:  END  CREATE; 
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LIST-TRAFSUB  — 


Member  Name LST 

PT  /I 
Language iJJ/ 

Subroutines ™™TX1 

.  .  SYSPRINT  —  IBM  messages 

brLLes PRINTER  --  LIST-TRAFSUB  output 

TRAFSUB  —  Traffic  Summary  file 

1-3   "LST" 
Instruction  40  -  43  Beginning  route  number 

56  -  59  Ending  route  number 


: 


LIST-TRAFSUB  provides  a  listing  of  the  Traffic  Summary  file.   For  each  of  the 
three  data  years  is  shown  the  vehicle  miles  for  all  vehicles,  commercial 
vehicles,  and  out-of-state  vehicles  (vehicle  miles  for  pickups  is  not 
shown).  The  section  length,  key,  and  remark  are  also  printed. 
The  LST  program  listing  follows: 
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/*  LIST-TRAFSUB,DATA=XXXXX  */ 

l:  /*  LIST-TRAFSUBtOATA=XXXXX  */ 

2:  LIST:   PRQCEOURE  (PARM)  OPTIONS  (MAIN) 


3 

4 
5 
6 
7 
8 
9 
10 
11 

12 
13 
14 
15 
16 
17 
18 
19 
20 
21 
22 
23 

24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 


/*  INSTRUCTION  L    PRINT  ROUTINE  */ 
DECLARE 

PARM  CHAR(IOO) , 

INSTR  CHAR(80)  EXT, 

STARTKEY  CHARI4)  OEF  INSTR  P0S(40), 

ENDKEY  CHAR(4)  DEF  INSTR  P0SI56), 

#_HDGS  PIC^Z*  DEF  INSTR  P0S(72), 
(HEADING(9) , PRINTER)  CHARI132)  EXT, 

PRINTX  ENTRY  (PIC1!'); 

/*  TRAFSUB  FILE  */ 
DECLARE 

1   SUB  BASED  (PTR_SUB), 
2   DUM1  CHAR( 1) , 
2   RT_#  CHARI4) , 
2   MPOST  CHARI3) , 
2   OFFSET  CHAR(6), 
2   REMARK  CHARI 1), 
2   LENGTH  DEC  FIXED  (7,3), 
2   DATA(3), 

3  (VM1,VM2,VM3,VM4)  DEC  FIXED  (11,3), 
TRAFSUB  FILE  INT  RECORD  KEYED  ENV  (INDEXED  GENKEY) ; 

/*  OUTPUT  STRUCTURE  */ 
DECLARE 

OUT    CHARU32)     STATIC     INIT     (•     •), 
1       0    DEF    OUT, 

2   RT_#  CHAR(5) , 

2   MPOST  CHAR(3), 

2   OFFSET  CHAR(7), 

2   REMARK  CHAR( 1), 

2   LENGTH  PIC • ZllllM  .III • , 

2   DATA(3), 

3  ( VM1,VM2,VM4)  PICMIOIZ'; 


35:  /*****  INITIALIZATION  *****/ 

36:  CALL  INIT  (PARM); 

37:  #_HDGS  =  2; 

38:  HEADING(l)  =  «RT-#   MP  OFFSET     LENGTH   ************! ******t  || 

39:         !♦*♦♦♦****   ***********<c«2**************  •  || 

40:         •   *************3**************« ; 

41:  OPEN  FILE  (TRAFSUB); 

42:  ON  ENDFILE  (TRAFSUB)  BEGIN; 

43:         PRINTER  =  •    END  OF  FILE.1; 

44:        CALL  PRINTX  (3) ; 

45:        GOTO  DONE; 

46:         END; 

47:  READ  FILE  (TRAFSUB)  SET  (PTR_SUB)  KEY  (STARTKEY); 

48:  /*****  EXECUTION  LOOP  *****/ 
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/*    |_IST-TRAFSUB,DATA  =  XXXXX    */ 

49:  00    WHILE    ( SUB.RT_#<=ENDKEY ) ; 

50:  0    =    SUB,    BY    NAME; 

51:  PRINTER    =    OUT; 

S  ^L0    ^fm-SUB,    SET    ,PTR_SUB(J 

54:  END; 

55:  DONE: 

56:  CLOSE    FILE    ITRAFSUB); 

57:  CALL    EXIT    (PARM); 

58:  END    LIST; 
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TRAFFIC-BY-SECTIONS  — 

Member  Name TRT 

Language PL/I 

Subroutines  PRINTX1 

Files SYSPRINT  —  IBM  messages 

PRINTER  —  TRAFFIC-BY-SECTIONS  output 
ROADLOG  —  Roadlog  file 
TRAFSUB  —  Traffic  Summary  file 
CNTYTBL  —  Table  of  county  names 

Instruction 1  -  3  "TRT" 

40  -  43  Beginning  route  number 
56  -  59   Ending  route  number 

TRT  produces  the  main  body  of  the  Traffic  by  Sections  report.   It  utilizes  the 
Traffic  Summary  and  Roadlog  files.   It  must  also  read  the  county  table  in 
HIS. TABLES  in  order  to  print  the  county  names.   The  vehicle  mileage  and  sec- 
tion length  are  obtained  from  the  Traffic  Summary  file.   From  this,  the  ADT's 
are  calculated  (vehicle  miles/length) .   The  Roadlog  file  is  accessed  to 
obtain  the  section  descriptions  and  the  county  numbers.   The  county  names 
are  read  into  an  array  during  program  initialization,  and  the  county  numbers 
are  used  as  indexes  into  the  array  to  obtain  the  county  name. 
The  TRT  program  listing  follows: 
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/*  :TRAFFIC-BY-SECTIONS,DATA=XXXXX  */ 

l:  /*  :TRAFFIC-BY-SECTIONS,DATA=XXXXX  */ 

2:  TR8YSEC:   PROCEDURE  (PARM)  OPTIONS  (MAIN) 


3 

4 

5 

6 

7 

8 

9 

10 

11 

12 

13 

14 


25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 
39 
40 
41 
42 
43 


/*  INSTRUCTION  AND  PRINT  ROUTINE  */ 

DECLARE 

PARM  CHAR(IOO), 
INSTR  CHAR(80)  EXT, 

PAGE  SUE  PIC»ZZ»  DEF  INSTR  P0S(7), 
PAGE^POSITION  PIC'ZZ*  DEF  INSTR  P0SC9), 
STARTKEY  CHAR(4)  DEF  INSTR  P0S(40), 
ENDKEY  CHAR(4)  DEF  INSTR  P0S(56), 
#_HDGS  PIC'Z*  DEF  INSTR  P0S(72), 
(HEADING(9), PRINTER)  CHAR(132)  EXT, 
PRINTX  ENTRY  (PIC'Z1) , 
PRINTXA  ENTRY  (P IC • Z* ,P IC1 ZZ • ) ; 


15:  /*  ROADLOG  VARIABLES  */ 

16:  DECLARE 

17:     1   RLG  BASED  (PTR.RLG), 

18:         2   DUMl  CHARU4), 

19:        2   REMARK  CHARC2), 

20:        2   DUM2  CHAR( 14) , 

21:         2   DESCR  CHAR(35), 

22:        2   DUM3  CHAR( 16) , 

23:        2   COUNTY_#  DEC  FIXED  (3,0), 

24:     ROADLOG  FILE  INT  RECORD  KEYED  ENV  (INDEXED); 


/*  TRAFFIC  SUMMARY  FILE  */ 
DECLARE 

1   SUB  BASED  (PTR_SUB), 
2   DUMl  CHAR( 1) , 
2   SYSTEM  CHAR(l), 
2   RT_#  PIC'9991, 
2   MPOST  PIC«999«, 
2   DUM2  CHAR(2) , 
2   OFFSET  CHAR(3), 
2   DUM3  CHAR( 1) , 
2   REMARK  CHAR(l), 
2   LENGTH  DEC  FIXED  (7,3), 
2   D(3), 

3  ( VM,VM_FOR,VM_PIC, VM_COMM)  DEC  FIXED  (11,3) 
1   SUB2  BASED  (PTR_SUB), 
2   DUMl  CHAR(l), 
2   KEY  CHAR(13) , 
2   YR(3)  CHAR(2), 
TRAFSUB  FILE  INT  RECORD  KEYED  ENV  (INDEXED  GENKEY) ; 


44:  /*  OTHER  VARIABLES  */ 

45:  DECLARE 

46:     LINES  CHARU03)  STATIC  INIT  ((103)1-1), 

47:     C0UNTY(0:57)  CHAR(15)  STATIC, 

48:     RECORD  CHAR(80)  BASED  (PTR.TBL), 

49:     CNTYTBL  FILE  INT  RECORD, 

50:     ZRT_#  PIC'ZZZZ1, 

51:     ZMPOST  910*119^ 

52:     LNGTH  PIC • ZZ9V.9991 , 

53:     ADT(3,3)  DEC  FIXED  (7,0), 
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/*  :TRAFFIC-BY-SECT IONS, OAT A=XXXXX  */ 

54:  (FADT(3,3),VM(3))  PIC»(6)Z»; 

55:  /*****  INITIALIZATION  *****/ 

56:  CALL  INIT  (PARM); 

57:  #_HDGS  =  5; 

58:  HEADINGI3)  =  •   MILE*  ; 

59:  SUBSTR(HEADING(3> ,71f3iJ  =  •SECTION  *******ADT*******    VEH'; 

60:  HEADING(4)  =  •   POST         SECTION  DESCRIPTION  <  II 

61:         'COUNTY         TRAFFIC  TYPE   LENGTH  MILES1; 

62:  /*  READ  TABLE  OF  COUNTY  NAMES  */ 

63:  COUNTY(O)  =  • ***  INVALID  ***•; 

64:  COUNTY(57)  =  •  OUT  OF  STATE1; 

65:  OPEN  FILE  (CNTYTBL); 

66:  DO  1=1  TO  56; 

67:        READ  FILE  (CNTYTBL)  SET  (PTR.TBL); 

68:        COUNTY(I)  =  SUBSTR (RECORD, 16, 15 ) ; 

69:         END; 

70:  CLOSE  FILE  (CNTYTBL); 

71:  /*  INIT  FILES  */ 

72:  OPEN 

73:         FILE  (TRAFSUB), 

74:        FILE  (ROADLOG); 

75:  ON  ENDFILE  (TRAFSUB)  GOTO  DONE; 

76:  ON  KEY  (ROADLOG)  BEGIN; 

77:  RLG.DESCR    =    ******    NO    ROADLOG    RECORD    *****•; 

78:         RLG.COUNTY_#  =  0; 

79:         END; 

80:  /*  GET  DATES  */ 

81:  READ  FILE  (TRAFSUB)  SET  (PTR_SUB); 

82:  SUBSTR(HEADING(4),81,2)  =  SUB2.YR(1); 

83:  SUBSTR(HEADING(4),87, 2)  =  SUB2.YR(2); 

84:  SUBSTR(HEADING(4),93,2)  =  SUB2.YR(3); 


90 
91 
92 
93 
94 
95 
96 
97 
98 
99 
100 
101 


85:  /*  READ  FIRST  RECORD  OF  ROUTE  */ 

86:  READ  FILE  (TRAFSUB)  SET  (PTR.SUB)  KEY  (STARTKEY); 

87:  ZRT_#  =  SUB.RT_#; 

88:  HEADING(l)  =  •  FA»  II  SUB. SYSTEM  II  ZRT_#; 


89:  /*****  EXECUTION  LOOP  *****/ 


LOOP: 

READ  FILE  (ROADLOG)  SET  (PTR.RLG)  KEY  (SUB2.KEY); 
IF  SUB.REMARK=«C  I  SUB.REMARK= • S*  I  SUB .REMARK= • L ■  THEN  DO; 
PRINTER  =  (35)'  •  II  RLG.DESCR; 

/*  TEMP  */  IF  SUB.REMARK=«C«  THEN  SUBSTR ( PRI NTER, 54, 17 )  = 
SUBSTR(DESCR,21,3)  I)  •  TO  •  I  I  SUBSTR ( DESCR,27, 3 )  || 
SUBSTR(DESCR,31,3); 
CALL  PRINTXA  (2,8); 
GOTO  NEXT_RECORD; 
END; 
ZMPOST  =  SUB.MPOST; 
PRINTER  =  ZMPOST  II  SUB. OFFSET  II  ■   •  II  RLG.DESCR; 
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/*  :TRAFFIC-BY-SECTIONS,OATA*XXXXX  */ 


102 
103 
104 
105 
106 
107 
108 
109 
110 
111 
112 
113 
114 
115 
116 
117 
118 
119 
120 
121 
122 
123 
124 
125 
126 
127 
128 
129 
130 
131 
132 
133 
134 
135 
136 
137 
138 
139 
140 


CALL  PRINTX  11); 

IF  SU8. REMARKED*  THEN  GOTO  NEXT.RECORD; 

IF  SUB.REMARK=»E»  THEN  00; 

DO  WHILE  (SUB.REMARK=,E« I; 

READ  FILE  (TRAFSUB)  SET  (PTR_SUB); 

end; 

IF  SUBSTR(SUB2.KEY,1,4)>ENDKEY  THEN  GOTO  DONE; 
IF  PAGE_SIZE-PAGE_P0SITI0N>2  THEN  DO; 

PRINTER  =  LINES; 

CALL  PRINTX  (2); 

end; 

ZRT_#  =  SUB.RT_#; 

HEADING(l)  =  •  FA»  II  SUB. SYSTEM  ||  ZRT_#; 

IF  PAGE_POSITI0N  +  10<PAGE__SIZE 
THEN  DO; 

PRINTER  =  HEADING(l); 
CALL  PRINTX  (3); 
PRINTER  =  •  •; 
CALL  PRINTX  (2); 
END; 
ELSE  PAGE_POSITION  =  PAGE.SIZE; 
GOTO  LOOP; 
END; 
IF  PAGE_SIZE-PAGE_P0SITI0N<=4  THEN  CALL  PRINTX  (9); 
LNGTH  =  SUB. LENGTH; 
IF  SUB.REMARK=«N»  THEN  DO; 

PRINTER  =  (46)»  •  II  •**  NON  EXISTANT**1  II  (8)«  '  II  LNGTH 
CALL  PRINTX  (2); 
PRINTER  =  •  • ; 
CALL  PRINTX  (1); 

GOTO  next__record; 

END; 
ADT(*,1)  =  SUB.D.VM  /  SUB. LENGTH; 
ADT(*,2)  =  SUB.D.VM_COMM  /  SUB. LENGTH; 
ADT<*,3)  =  SUB.D.VM_FOR  /  SUB. LENGTH; 
FAOT  =  ADT; 
VM(  1)  =  SUB. 0(3) .VM; 
VM(2)  =  SUB.D(3) .VM_COMM; 
VM(3)  =  SUB.D(3) .VM_FOR; 


141:  /*  ALL  VEHICLES  */ 

142:  IF  ADT( 1, 1 )+ADT ( 2, 1 ) *ADT( 3, 1)^=0 

143:         THEN  PRINTER  =  ( 57 )  •  •  I  I  »ALL  VEHICLES  •  II 

144:  FADT(ltl)  II  FADT(2,l)  II  FADT(3,1)  II  VM(1); 

145:        ELSE  PRINTER  =  •  ■  ; 

146:  CALL  PRINTX  (1); 

147:  /*  COMMERCIAL  VEHICLES  */ 

148:  IF  RLG.REMARK=«OS»  THEN  RLG.COUNTY_#  *  57; 

149:  IF  ADT(l,2)+ADT(2,2)+ADT(3,2)-.=  0 

150:        THEN  DO; 

151:  PRINTER  =  (39)'  •  I  I  COUNTY( RLG. COUNTY_# )  I  I 

152:  ■    COMMERCIAL    ■  II  LNGTH  I  I 

153:  FADT(i,2)  II  FADT(2,2)  II  FADT(3,2)  II  VM(2); 

154:  CALL  PRINTX  (1); 

155:  END; 

156:        ELSE  DO; 

157:  PRINTER  =  (39)  •  •  ||  COUNTY( RLG. COUNTY_#)  I  I  ( 16 )  •  •  II  LNG 
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/*    :TRAFFIC-BY-SECTIONS,DATA=XXXXX    */ 

158:  CALL    PRINTX    <0); 

159:  END; 

160:     /*  OUT  OF  STATE  VEHICLES  */ 

161:     IF  AOT( 1,3) *ADT( 2,31+ AOT ( 3,3 )-=0  THEN  DO; 

162:        PRINTER  =  (57I1  •  II  'OUT  OF  STATE*  II  ( 8) •  ■  II 

163:  FADT11.3)  II  FADT(2,3)  If  FADT(3,3)  II  VM(3); 

164:        CALL  PRINTX  (1) ; 

165:        END; 

166:  NEXT_RECORD: 

167:     READ  FILE  (TRAFSUBI  SET  (PTR.SUB); 

168:     GOTO  LOOP; 

169:  DONE: 

170:     CLOSE 

171:         FILE  (TRAFSUB), 

172:         FILE  (ROADLOG) ; 

173:     CALL  EXIT  (PARMI; 

174:  END  TRBYSEC;- 
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SUMMARY-BY-ROUTES  — 

Member  Name NBT 

Language PL/ 1 

Subroutines  PRINTX1 

Files SYSPRINT  «  IBM  messages 

PRINTER  —  SUMMARY-BY-ROUTES  output 
TRAFSUB  —  Traffic  Summary  file 

Instruction 1  -  3  "NBT" 

6  Route  System  ("I,"  "P,"  or  "S") 

SUMMARY-BY-ROUTES  prints  the  summary  of  rural  mileage,  rural  ADT,  and  rural 
vehicle  mileage  that  appears  after  the  traffic-by-sections  listing  in  the 
Traffic  by  Sections  report.  The  traffic  summary  file  contains  records  with 
the  route  and  system  totals;  NBT  need  only  read  these  records,  calculate  ADT's 
by  dividing  the  vehicle  miles  by  the  route  lengths,  and  print  the  values. 
The  NBT  program  listing  follows: 


-216- 


/***  TRAFFIC  SUMMARY  BY  ROUTES  ***/ 

/***  TRAFFIC  SUMMARY  BY  ROUTFS  ***/ 
NBT:  PROCEDURE(PARM)  OPT  IONS ( MA  IN ) ; 
DECLARE 
(HEADING(9) .PRINTER )  CHARI132)  EXT, 
BLANK  CHARU32)  INIT(  •  •  ), 
PRINTX  ENTRY(PICZ'  )  , 
PARM  CHAR(IOO) , 
INSTR  CHAR(80)EXT, 

#_HDGS  PICZ«  DEF  INSTR  POS  (72), 
SYSTEM  CHAR<1)  DEF  INSTR  P0S(6); 
/*  FOP  YR  OF  TRAFFIC  FILE  */ 
DECLARE 
1  CUR_YR, 

2  DUM1  CHAR(  1), 
2  KEY  CHAR{ 13) , 
2  DUM2  CHAR(4) , 
2  YEAR  CHARI2), 
2  DUM3  CHAR<76); 
/*  FOR  TRAFFIC  SUMMARY  FILE  */ 
DECL  ARE 
1  SUM, 

2  DUM1  CHAR(  1), 

?    KEY  CHARf 13) , 

2  REMARK  CHAR(l), 

2  LEN  DEC  FIXED(7,3)  , 

2  DATA1  CHARI24), 

2  DATA2  CHARC24) , 

2  DATA3, 

3  (VM,VMFOR,DUM2,VMCOM)  DEC  FIXED(il,3) 
2  DUM3  CHARI5); 
/*  FOR  SYSTEM  TOTALS  */ 
DECLARE 
1  SYS, 

2  DESCR  CHAR(U)  INIT{«   NET  TOTAL1), 
2  RMI  PIC  (7)ZV.Z'  , 
2  AALL  PICM11IZ', 
2  ACOM  PIC  (fl)Z'  , 
2  AFOR  PIC  (8)7*  , 
2  VMALL  PIC  (  13)Z«  , 
2  VMCOM  PIC  (9)Z'  , 
2  VMFOR  PIC  <9)Z'  , 

2  TPALL  PIC(8)ZV.ZZ»  IN  I  T  (  100  .  00  )  , 
2  TPCOM  PIC  (5)ZV.ZZ  '  , 
2  TPFOR  PIC  (5)  ZV.ZZ'  ; 
/*  FOR  ROUTE  TOTALS  */ 
DECLARE 
1  RT, 

2  DUMl  CHAR( 5)  INIT( ■  • ) , 
2  ROUTE_#  CHAR( 3) , 
2  RMI  PIC  I  10)  ZV.Z'  , 
2  AALL  PIC  (  11)  Z*  , 

2  acom  pic  mz» , 

2  AFOR  PIC  (8)Z»  , 
2  VMALL  PICM13IZS 
2  VMCOM  PIC  (9)Z*  , 
2  , VMFOR  PIC  (9)Z'  , 
2  PALL  PIC  <8)ZV.ZZ»  , 
2  PCOM  PIC  C5)ZV.ZZa  , 
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/***  TRAFFIC  SUMMARY  BY  ROUTES  ***/ 
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2  PFOR  PIC* (5)ZV.ZZ» ; 
/*  MISC  VAR  */ 

DECLARE 
TRAFSUM  FILE  RECORD  KEYED  ENVUNDEXED  GENKEY), 
1  TSUM  LIKE  SUMf 
TMI  DEC  FIXFD(9,3), 
TVM(3)  DEC  FIXED(9,0)t 
KEYT  CHAR<13), 
IND  BINARY  FIXED, 
STRING_RT  CHARU05)  DEF  RT, 
STRING_SYS  CHARU05)  DEF  SYS; 
/**  PGM  INITIALIZATION  **/ 
CALL  INIT  (PARM); 
OPEN  FILE(TRAFSUM)  INPUT  SEQL  T  I  TLE  (  •  TR  AFSUB  •  )  *, 
READ  FILF(TRAFSUM)  INTO  ( CUR_YR )  KEYCAOOO*); 
/*  HOGS  FOR  SUM  */ 
tf_HDGS=7; 

TMI=0; 
HEADING* 1)=SUBSTR( BLANK, 1,53 H  I » 19* | | CUR_YR . YEAR ; 
HEADING! 2)=SUBSTR< BLANK, 1,38)  I  I  *  INTERSTATE   RURAL   ROU* I  I 
•TE   SUMMARY1; 
IF  SYSTEM=»P*  THEN  DO; 

HEADING(2)=SUBSTR( BLANK, 1,40) | | 'PRIMARY   RURAL   ROU'll 

•TE   SUMMARY*; 
END; 
IF  SYSTEM=*S'  THEN  DO; 

HEADING(2)=SUBSTR(BLANK, 1,39) | | •SECONDARY   RURAL   R'll 

•OUTE   SUMMARY'; 
END; 
HEADING<4)=*  AVERAGE  DAILY  TRAFFIC  '|| 

i         *****VEHICLE  MILES*****       X    OF  TOTAL  VFH.  MILES'; 
HEADING(6)='      ROUTE     RURAL  ALL    COMMFR-  OUT  OF » | I 

1  ALL     COMMER-   OUT  OF        ALL    CUMMER-  OUT  OF' 

HEADING(7)='       NO     MILEAGE     VEHICLES   CIAL     STATE*  || 
VEHICLES    CIAL      STATE     VEHICLES   CIAL     STATE* 
/*  TOTALS  FUR  SYSTEM  PRCNT  COMPUTATIONS  */ 

READ  F  ILE(TRAFSUM)  INTO(TSUM)  KEY( SYSTEM |  |  • 999RURAL ')  ; 
/*  CHFCK  FOR  COMMERCIAL  L    FOREIGN  VEH. MILES  */ 
/*  ALLOWS  FOR  CORRECT  FINAL  PRCNTS  */ 

IF  TSUM.DATA3.VMC0M=0  THEN  SYS.TPCOM=0; 

ELSE  SYS.TPCOM=100.C0; 
IF  TSUM.DATA3.VMFOR=0  THEN  SYS.TPFOR=0; 
ELSE  SYS.TPFOR=100.00; 

READ  FILE(TRAFSUM)  INTO  (SUM)  KEY(SYSTEM); 
ON  ENDFILE(TRAFSUM)  GOTO  CHECK; 
GOTO  R02; 
ROl: 

READ  FILE(TRAFSUM)  INTO(SUM); 
/*  CK  FOR  ROUTE  TOTAL  KEY  */ 
R02: 

IF  SUM.KEY=SYSTEM| | '999RURAL'  THEN  GOTO  SYS_TOT; 
IF  SUM.KEY-  =  SYSTEM|  | SUBSTR ( SUM. K FY , 2 ,3 )  I  I  '999RURAL'  THEN  DO; 
KEYT= SYSTEM |  | SUBSTR ( SUM. KEY, 2 , 3)  I  I '999RURAL' ; 
READ  FILE(TRAFSUM)  INTO(SUM)  KEY(KEYT); 
GOTO  R02; 
END; 
/*  ONF  ROUTE  CALC  */ 

RT.PUUTF_#=SUBSTR(SUM.KEY,2,3); 
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/***  TRAFFIC  SUMMARY  BY  ROUTFS  ***/ 
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PT.R 
IF  S 
RT.A 
RT.  A 
RT.A 

end; 

FLSF 

RT.V 

RT.V 

RT.V 

RT.P 

IF  S 

ELS 

IF  S 

ELS 

/*  ROU 

PRIN 

CALL 

GCTL) 

/*  SYS 

SYS.TO 

IND= 

SYS. 

SYS. 

SYS. 

SYS. 

SYS. 

SYS. 

SYS. 

/*  SYS 

PRIN 

CALL 

/*  CLO 

CHECK  : 

IF  I 

CLOS 

CALL 

END 


MI=SUM.LEN+.05; 

UM.LENi=0  THEN  DO; 

ALL=SUM.DATA3.VM/SUM.LEN+.5; 

CnM=SUM.DATA3.VMCOM/SUM.LFN+.5; 

Fr»R=SUM.DATA3.VMFOR/SUM.LEN+.5; 

RT.A  ALL  ,RT.ACf)M,RT.AFOR  =  0; 
MALL=SUM.DATA3.VM+.5; 
MC0M=SUM.DATA3.VMC0M+.5; 
MFGR=SUM.DATA3.VMFDR*-.5; 
ALL=(SUM.DATA  l.VM/TSUM.0ATA3.VM)*100+.005; 

UM.DATA3.VMCOM=0  THEN  RT.PCOM=0; 

F  RT.PCOM  =  (SUM.DATA3.VMCQM/TSUM.DATA3.VMCr)M)*b)0+.105; 

UM.DATA3.VMF0R=0  THEN  RT.PFOR=0; 

E  RT.PFOR=(SUM.DATA3.VMFOR/TSUM.DATA3.VMFOR )*100*.005; 

TE  PRINT  */ 

TER=STRING_RT; 

PRINTX<2)  ; 

ROl; 
TEM  CALCS  */ 
T: 

l; 

RMI=SUM.LEN; 

AALL=TSUM.DATA3.VM/TSUM.LEN+.5; 

ACQM=TSUM.DATA3.VMC0M/TSUM.LEN-»-.5; 

AFUR=TSUM.DATA3.VMF0R/TSUM.LEN+.5; 

VMALL=TSUM.DATA3.VM; 

VMCQM=TSUM.DATA3.VMC0M; 

VMF0R=TSUM.CATA3.VMF0R; 

TEM    TOTAL    PRINT    */ 

TER=STRING_SYS; 

PRINTXI2)  ; 
SE  OF  PROG  */ 


ND-.=  1  THEN  GOTO 
E  FILE(TRAFSUM) ; 

EXIT(PARM) ; 
NBT; 


SYS_TOT; 
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